﻿<!-- #Include File="Config.asp" -->
<%
Dim HtmlContent
Dim Action, FoundErr, ErrMsg, ComeUrl
Dim Session_For:Session_For = "Admin_"
Dim Cookies_For:Cookies_For = "Admin_"
Dim BeginTime:BeginTime = Timer
Dim UserTrueIP
Dim ScriptName
Dim Site_Sn
Dim ObjInstalled_FSO, Fso
Dim StrShowPath, Tit, SpecialID, sType
'分页时所用变量
Dim FileName, strFileName, MaxPerPage, CurrentPage, totalPut
'搜索用变量
Dim SearchType, strField, Keyword
Dim arrCardUnit, arrUserType

'正则表达式相关的变量
Dim regEx, Match, Match2, Matches, Matches2
Set regEx = New RegExp
regEx.IgnoreCase = True
regEx.Global = True
regEx.MultiLine = True

ScriptName = Trim(Request.ServerVariables("SCRIPT_NAME"))
UserTrueIP = Request.ServerVariables("HTTP_X_FORWARDED_FOR")
If UserTrueIP = "" Then UserTrueIP = Request.ServerVariables("REMOTE_ADDR")
If Not(checkget(UserTrueIP,"ip")) Then UserTrueIP="unknow"
UserTrueIP = ReplaceBadChar(UserTrueIP)
If EnableStopInjection = True Then
	If Request.QueryString <> "" Then Call StopInjection(Request.QueryString)
	If Request.Cookies <> "" Then Call StopInjection(Request.Cookies)
	If LCase(Mid(ScriptName, InStrRev(ScriptName, "/") + 1)) <> "upfile.asp" Then
		Call StopInjection2(Request.Form)
	End If
End If
FoundErr = False
ErrMsg = ""

ObjInstalled_FSO = IsObjInstalled(Fso_Sys)
If ObjInstalled_FSO = True Then
	Set Fso = Server.CreateObject(Fso_Sys)
Else
	Response.Write "<li>FSO组件不可用，各种与FSO相关的功能都将出错！请运行Install.asp或者到后台网站配置处设置好FSO组件名称。</li>"
End If

If Request("Page") <> "" Then
	CurrentPage = Code_CLng(Request("Page"))
Else
	CurrentPage = 1
End If
MaxPerPage = Code_CLng(Trim(Request("MaxPerPage")))
If MaxPerPage <= 0 Then MaxPerPage = 20
SearchType = Code_CLng(Trim(Request("SearchType")))
strField = Trim(Request("Field"))
Keyword = ReplaceBadChar(Trim(Request("Keyword")))

ComeUrl = FilterJs(Trim(Request("ComeUrl")))
If ComeUrl = "" Then
	ComeUrl = FilterJs(Trim(Request.ServerVariables("HTTP_REFERER")))
End If
Action = ReplaceBadChar(Trim(Request("Action")))
FoundErr = False
ErrMsg = ""
Site_Sn = Replace(Replace(LCase(Request.ServerVariables("SERVER_NAME") & InstallDir), "/", ""), ".", "")
arrCardUnit = Array("点", "天", "月", "年", "元", "卡")
arrUserType = Array("个人会员", "企业会员（创建者）", "企业会员（管理员）", "企业会员（普通成员）", "企业会员（待审核成员）")

'================================================
'作  用：从ndata表中查找指定id，该id为ndata表中的最新数据
'================================================
Function first_id(ndata,id)
	dim rsf
	Call Exec(rsf,"select top 1 "&id&" from "&ndata&" order by "&id&" desc",2)
	first_id=rsf(id)
	rsf.close
	set rsf=nothing
End Function

Public Function Echo(byval t0)
	Response.Write t0 & vbCrLf
End Function

Public Function Flushs()
	Response.Flush()
End Function

'//* 页面跳转 *//
Public Function Format_Redirect(ByVal rUrl)
	Response.Redirect rUrl
	Response.End()
End Function

'//* 用户IP *//
'-- IP SYS
'-- 0=ip，1=sys
Public Function Ip_Sys(ByVal St)
	If St=1 Then
		Ip_Sys=Request.ServerVariables("Http_User_Agent")
		Exit Function
	End If
	Dim userip,userip2
	userip=Request.ServerVariables("HTTP_X_FORWARDED_FOR")
	userip2=Request.ServerVariables("REMOTE_ADDR")
	If Instr(userip,",")>0 Then userip=Left(userip,Instr(userip,",")-1)
	If Instr(userip2,",")>0 Then userip2=Left(userip2,Instr(userip2,",")-1)
	If userip="" Then
		Ip_Sys=userip2
	Else
		Ip_Sys=userip
	End If
End Function

'//* COOKIES、CACHE、SESSION操作部分开始 *//
'-----------Cookies操作-------------
Public Function Cookies_Set(MyCookieName,CookieStr)
	Response.Cookies(InstallCookies)(MyCookieName)=CookieStr
End Function

Public Function Cookies_Get(MyCookieName)
	Cookies_Get=Trim(Request.Cookies(InstallCookies)(MyCookieName))
End Function

Public Function Cookies_Del(MyCookieName)
	Response.Cookies(InstallCookies)(MyCookieName)=Empty
End Function

Public Function Cookies_Delele()
	Dim Cookies_Name
	For Each Cookies_Name In Request.Cookies(InstallCookies)
		Response.Cookies(InstallCookies)(Cookies_Name)=Empty
	Next
End Function

'-----------Session操作-------------
Public Function Session_Set(MySessionName,SessionStr)
	Session(InstallCookies&"_"&MySessionName)=SessionStr
End Function

Public Function Session_Get(MySessionName)
	Session_Get=Session(InstallCookies&"_"&MySessionName)
End Function

Public Function Session_Del(MySessionName)
	Session(InstallCookies&"_"&MySessionName)=Empty
End Function

Public Function Session_Delele()
	Session.Abandon
End Function

Sub Copy_Data(OldName,NewName)
	Call Exec("","Select * Into "&NewName&" From "&OldName&" Where 1<>1",0)
End Sub

Public Function Out_Msg(Msg,Gurl)
	Dim Strer
	Strer="<script type='text/javascript'>alert('"&Msg&"');"
	select case Gurl
	case "close"
	Strer=Strer&"window.close();"
	case "back"
	Strer=Strer&"history.back();"
	case ""
	case else
	Strer=Strer&"location.href='"&Gurl&"';"
	end select
	Strer=Strer&"</script>"
	Out_Msg=Strer
End Function

Public Function Dialog(Id,Msg,Gurl,Width,Height,BtnBar,Content)
	Dim Strer
	Strer="<script type='text/javascript'>ItemDialog('" & Id & "','" & Msg & "','" & InstallDir & Gurl & "'," & Width & "," & Height & ");</script>"
	Dialog=Strer
End Function

Public Function IsSuccess(Msg,Gurl)
	Dim Strer
	Strer="<script type='text/javascript'>IsSuccess('" & Msg & "','" & InstallDir & Gurl & "');</script>"
	IsSuccess=Strer
End Function

Public Function IsConfirm(Msg,Okurl,Cancelurl)
	Dim Strer
	Strer="<script type='text/javascript'>IsConfirm('" & Msg & "','" & InstallDir & Okurl & "','" & InstallDir & Cancelurl & "');</script>"
	IsConfirm=Strer
End Function

Public Function Check_Object(current_value,value,value2)
	dim temp_str
	if instr(current_value,value)>0 Then
	temp_str=value2
	else
	temp_str=""
	end if
	Check_Object=temp_str
End Function

Public Function Check_Object2(current_value,value,value2)
	dim temp_str
	if StrComp(current_value,value,1)=0 Then
	temp_str=value2
	else
	temp_str=""
	end if
	Check_Object2=temp_str
End Function

Public Function Check_Object3(current_value,value,value2,value3)
	dim newarr,g,temp_str
	newarr=split(current_value,value3)
	for g=0 to ubound(newarr)
	if StrComp(newarr(g),value,1)=0 Then
	temp_str=value2
	exit for
	end if
	next
	Check_Object3=temp_str
End Function

Public Function Channel_Num()
	Dim rsCount, UnPassed
	Call Exec(rsCount,"select count(ChannelID) from Channel where ChannelHidden=" & WK_False,2)
	If Not (rsCount.EOF And rsCount.bof) Then
		UnPassed = rsCount(0)
	Else
		UnPassed = 0
	End If
	Channel_Num = UnPassed
End Function

Public Function Get_ChannelSetup(ByVal cSetup,ByVal sNum)
	Get_ChannelSetup = 0
	sNum = sNum + 1
	If Len(cSetup) <> 20 Or sNum > 20 Then Exit Function
	Get_ChannelSetup = Int(Mid(cSetup,sNum,1))
End Function

Public Function ShowTit(ClassID)
	Dim rs,sql,LocationText
	if ClassID<>0 Then
		sql="Select * From Class where ClassID=" & ClassID
		Call Exe_Conn(rs,sql,1)
		if rs.bof and rs.eof Then
			ShowTit=""
			Exit Function
		end if
		if rs("ClassParent")<>0 Then LocationText=ShowTit(rs("ClassParent"))
		LocationText=LocationText & " - " & rs("ClassName")
	end if
	ShowTit=LocationText
End Function

'--- 模板中常用配置替换 ---
Public Function ShowPath(ClassID)
	Dim rs,sql,LocationText
	if ClassID<>0 Then
		sql="Select * From Class where ClassID=" & ClassID
		Call Exe_Conn(rs,sql,1)
		if rs.bof and rs.eof Then
			ShowPath=""
			Exit Function
		end if
		if rs("ClassParent")<>0 Then LocationText=ShowPath(rs("ClassParent"))
		If ChannelIsCreateHtml = True Then
			ClassUrl=InstallDir & ChannelDir & "/" & Rs("HtmlFileDir") & "Index" & ChannelHtmlExtName
		Else
			ClassUrl=InstallDir & ChannelDir & "/List.asp?ClassID=" & rs("ClassID")
		End If
		LocationText=LocationText & "&nbsp;&gt;&nbsp;<a href='" & ClassUrl & "' class='LinkPath'>" & rs("ClassName") & "</a>"
	end if
	ShowPath=LocationText
End Function

'--- 模板中常用标签替换 ---
Public Function ReplaceHtml(ByVal HtmlStr)
	ReplaceHtml = Cstr(HtmlStr)
	ReplaceHtml = Replace(ReplaceHtml,"<!--{$",vbCrLf & "{$")
	ReplaceHtml = Replace(ReplaceHtml,"}-->","}")
End Function

'--- 模板中常用配置替换 ---
Public Function ReHtml(ByVal HtmlStr)
	ReHtml = Cstr(HtmlStr)
	ReHtml = Replace(ReHtml,"{$InstallDir}",InstallDir,1,-1,1)
	ReHtml = Replace(ReHtml,"{$SkinDir}",SkinDir,1,-1,1)
	ReHtml = Replace(ReHtml,"{$TemplateDir}",TemplateDir,1,-1,1)
	ReHtml = Replace(ReHtml,"{$IndexFile}",IndexFile,1,-1,1)
	ReHtml = Replace(ReHtml,"{$IndexShow}",IndexShow,1,-1,1)
	ReHtml = Replace(ReHtml,"{$SiteName}",SiteName,1,-1,1)
	ReHtml = Replace(ReHtml,"{$ShowPath}",StrShowPath,1,-1,1)
	ReHtml = Replace(ReHtml,"{$SiteUrl}",SiteUrl,1,-1,1)
	ReHtml = Replace(ReHtml,"{$SiteTitle}",SiteTitle,1,-1,1)
	ReHtml = Replace(ReHtml,"{$Tit}",Tit,1,-1,1)
	ReHtml = Replace(ReHtml,"{$SiteKeywords}",SiteKeywords,1,-1,1)
	ReHtml = Replace(ReHtml,"{$SiteDescription}",SiteDescription,1,-1,1)
	ReHtml = Replace(ReHtml,"{$SiteAuthor}",SiteAuthor,1,-1,1)
	ReHtml = Replace(ReHtml,"{$SiteCopyRight}",SiteCopyRight,1,-1,1)
	ReHtml = Replace(ReHtml,"{$LogoUrl}",LogoUrl,1,-1,1)
	ReHtml = Replace(ReHtml,"{$LogoWidth}",LogoWidth,1,-1,1)
	ReHtml = Replace(ReHtml,"{$LogoHeight}",LogoHeight,1,-1,1)
	ReHtml = Replace(ReHtml,"{$AdminFolder}",AdminFolder,1,-1,1)
	ReHtml = Replace(ReHtml,"{$upload_dir}",UploadSetting(1),1,-1,1)
	ReHtml = Replace(ReHtml,"{$download_dir}",InstallDir&UploadSetting(1),1,-1,1)
	ReHtml = Replace(ReHtml,"{$web_email}",WebmasterEmail,1,-1,1)
	ReHtml = Replace(ReHtml,"{$web_br}",vbcrlf,1,-1,1)
	ReHtml = Replace(ReHtml,"{$runtime}",FormatNumber((timer()-BeginTime), 2,-1),1,-1,1)
	ReHtml = Replace(ReHtml,"{$dbquery}",dbquery,1,-1,1)
	ReHtml = Replace(ReHtml,"<DIV","<div")
	ReHtml = Replace(ReHtml,"</DIV>",vbCrLf & "</div>" & vbCrLf)
	ReHtml = Replace(ReHtml,"<DD>",vbCrLf & "<dd>")
	ReHtml = Replace(ReHtml,"<DT>",vbCrLf & "<dt>")
	ReHtml = Replace(ReHtml,"<DL>",vbCrLf & "<dl>")
	ReHtml = Replace(ReHtml,"</DD>",vbCrLf & "</dd>" & vbCrLf)
	ReHtml = Replace(ReHtml,"</DT>",vbCrLf & "</dt>" & vbCrLf)
	ReHtml = Replace(ReHtml,"</DL>",vbCrLf & "</dl>" & vbCrLf)
	ReHtml = Replace(ReHtml,"<TABLE","<table")
	ReHtml = Replace(ReHtml,"</TABLE>",vbCrLf & "</table>" & vbCrLf)
	ReHtml = Replace(ReHtml,"<TBODY>","")
	ReHtml = Replace(ReHtml,"</TBODY>",vbCrLf)
	ReHtml = Replace(ReHtml,"<TR","<tr")
	ReHtml = Replace(ReHtml,"</TR>",vbCrLf & "</tr>" & vbCrLf)
	ReHtml = Replace(ReHtml,"<TD","<td")
	ReHtml = Replace(ReHtml,"</TD>","</td>")
	ReHtml = Replace(ReHtml,"<SELECT",vbCrLf & "<Select")
	ReHtml = Replace(ReHtml,"</SELECT>",vbCrLf & "</Select>")
	ReHtml = Replace(ReHtml,"<OPTION",vbCrLf & "  <Option")
	ReHtml = Replace(ReHtml,"</OPTION>","</Option>")
	ReHtml = Replace(ReHtml,"<INPUT",vbCrLf & "  <Input")
	ReHtml = Replace(ReHtml,"<SCRIPT","<Script")
	ReHtml = Replace(ReHtml,"</SCRIPT>","</Script>")
	ReHtml = Replace(ReHtml,"&amp;","&")
End Function

'--- 模板标签替换 ---
Public Function HtmlRcod(ByVal Mod_Str,ByVal View_Str)
	Mod_Str=LCase(Mod_Str)
	PutHtml=Replace(PutHtml,"{$"&Mod_Str&"}",View_Str)
End Function

Function LoseHtml(NameStr,ContentStr)
	Dim ClsTempLoseStr
	ClsTempLoseStr = Cstr(ContentStr)
	ClsTempLoseStr=Replace(ClsTempLoseStr," style=""""","",1,-1,1)
	ClsTempLoseStr=Replace(ClsTempLoseStr,"<tbody>","",1,-1,1)
	ClsTempLoseStr=Replace(ClsTempLoseStr,"</tbody>","",1,-1,1)
	ClsTempLoseStr=Replace(ClsTempLoseStr,"<body contenteditable=""true"">","<body>",1,-1,1)
	ClsTempLoseStr=Replace(ClsTempLoseStr,"<script type=""text/javascript"">var pc_file = '" & InstallDir & "';var admin_file = '" & AdminFolder & "/';</script>","",1,-1,1)
	ClsTempLoseStr=Replace(ClsTempLoseStr,"<script src=""../Plugins/htmledit/htmledit.js""></script>","",1,-1,1)
	ClsTempLoseStr=Replace(ClsTempLoseStr,"<script type=""text/javascript"" src=""" & InstallDir & AdminFolder & "/Plugins/js/jquery-2.1.4.js""></script>","",1,-1,1)
	ClsTempLoseStr=Replace(ClsTempLoseStr,"<script src=""" & InstallDir & AdminFolder & "/Plugins/smartMenu/jquery-smartMenu.js"" type=""text/javascript""></script>","",1,-1,1)
	ClsTempLoseStr=Replace(ClsTempLoseStr,"<link href=""" & InstallDir & AdminFolder & "/Plugins/smartMenu/smartMenu.css"" rel=""stylesheet"" type=""text/css"">","",1,-1,1)
	ClsTempLoseStr=Replace(ClsTempLoseStr,"<link href=""" & InstallDir & AdminFolder & "/Plugins/layer/skin/default/layer.css"" rel=""stylesheet"" type=""text/css"">","",1,-1,1)
	ClsTempLoseStr=Replace(ClsTempLoseStr,"<script src=""" & InstallDir & AdminFolder & "/Plugins/layer/layer.js"" type=""text/javascript""></script>","",1,-1,1)
	ClsTempLoseStr=Replace(ClsTempLoseStr,"<link href=""" & InstallDir & AdminFolder & "/Plugins/htmledit/htmledit.css"" rel=""stylesheet"" type=""text/css"">","",1,-1,1)
	ClsTempLoseStr=Replace(ClsTempLoseStr,"<div class=""layui-layer-move""></div>","",1,-1,1)
	ClsTempLoseStr=Replace(ClsTempLoseStr,"http://" & Trim(Request.ServerVariables("HTTP_HOST")) & "/","{$InstallDir}",1,-1,1)
	ClsTempLoseStr=Replace(ClsTempLoseStr,"Skin/","{$SkinDir}",1,-1,1)
	regEx.Pattern = "<link(\/){0,1}[^<>]*id=""layuicss-skinlayercss"">"
	regEx.IgnoreCase = True
	regEx.Global = True
	ClsTempLoseStr = regEx.Replace(ClsTempLoseStr,"")
	Set regEx = Nothing
	ClsTempLoseStr=Replace(ClsTempLoseStr,vbCrLf&vbCrLf,vbCrLf,1,-1,1)
	ClsTempLoseStr=Replace(ClsTempLoseStr,vbCrLf&vbCrLf,vbCrLf,1,-1,1)
	ClsTempLoseStr=Replace(ClsTempLoseStr,vbCrLf&vbCrLf,vbCrLf,1,-1,1)
	ClsTempLoseStr=Replace(ClsTempLoseStr,vbCrLf&vbCrLf,vbCrLf,1,-1,1)
	ClsTempLoseStr=Replace(ClsTempLoseStr,vbCrLf&vbCrLf,vbCrLf,1,-1,1)
	ClsTempLoseStr=Replace(ClsTempLoseStr,vbCrLf&vbCrLf,vbCrLf,1,-1,1)
	ClsTempLoseStr=Replace(ClsTempLoseStr,vbCrLf&vbCrLf,vbCrLf,1,-1,1)
	ClsTempLoseStr=Replace(ClsTempLoseStr,vbCrLf&vbCrLf,vbCrLf,1,-1,1)
	If NameStr<>"header.html" Then
		ClsTempLoseStr=Replace(ClsTempLoseStr,"<!DOCTYPE html><html lang=""zh-cn""><head>"&vbCrLf,"",1,-1,1)
		ClsTempLoseStr=Replace(ClsTempLoseStr,"</head><body>","",1,-1,1)
	End If
	If NameStr<>"footer.html" Then
		ClsTempLoseStr=Replace(ClsTempLoseStr,"</body></html>","",1,-1,1)
	End If
	LoseHtml = ClsTempLoseStr
End function

'取各种返回值
'Strers:字符串
'At    :类型
'Acut  :截短字符串数
Public Function Code_Admin(ByVal Strers,ByVal At,ByVal Acut)
	Dim Strer
	Strer=Trim(Strers)
	Select Case Int(At)
	Case 1
		Strer=Trim(Request.Form(Strer))
	Case 2
		Strer=Trim(Request.QueryString(Strer))
	End Select
	If Is_Null(Strer)="" Then
		Code_Admin=""
		Exit Function
	End If
	Strer=Replace(Strer,"'","""")
	If Int(Acut)>0 Then Strer=Left(Strer,Acut)
	Code_Admin=Strer
End Function

Public Function Code_Word(ByVal Strers)
	Dim Strer
	Strer=Trim(Strers)
	If Is_Null(Strer)="" Then
		Code_Word=""
		Exit Function
	End If
	Strer=Replace(Strer,Chr(39),"&#39;")		'单引号
	Strer=Replace(Strer,"<","&lt;")
	Strer=Replace(Strer,">","&gt;")
	Code_Word=Strer
End Function

Public Function Code_Js(ByVal Strers,ByVal Tt)
	Dim Strer
	Strer=Trim(Strers)
	If Is_Null(Strer)="" Then
		Code_Js=""
		Exit Function
	End If
	Strer=Code_Health(Strer)		'过滤不健康信息
	Strer=Replace(Strer,"\","\\")
	Strer=Replace(Strer,Chr(39),"&#39;")		'单引号
	'Strer=Replace(Strer,Chr(39),"\'")
	Strer=Replace(Strer,Chr(34),"&quot;")		'双引号
	'Strer=Replace(Strer,Chr(34),"\""")
	Select Case Tt
	Case 0
		'Strer=Replace(Strer,VbCrlf,"")			'回车
		Strer=Replace(Strer,Chr(10),"")
		Strer=Replace(Strer,Chr(13),"")
	Case 1
		'Strer=Replace(Strer,VbCrlf,"\n")			'回车
		Strer=Replace(Strer,Chr(10),"\n")
		Strer=Replace(Strer,Chr(13),"")
	End Select
	If Right(Strer,1)="\" Then
		Strer=Strer&"n"
	End If
	Code_Js=Strer
End Function

Public Function Code_Html(ByVal Strers,ByVal Chtype,ByVal CuteNum)
	Dim Strer
	Strer=Trim(Strers)
	If Is_Null(Strer)="" Then
		Code_Html=""
		Exit Function
	End If
	Strer=Code_Health(Strer)		'过滤不健康信息
	Select Case Chtype
	Case 3
		regEx.Pattern="<(.[^>]*)>"
		Strer = regEx.Replace(Strer,"")
	End Select
	If CuteNum>0 Then Strer=Cuted(Strer,CuteNum)
	Strer=Replace(Strer,"<","&lt;")
	Strer=Replace(Strer,">","&gt;")
	Strer=Replace(Strer,Chr(39),"&#39;")		'单引号
	Strer=Replace(strer,Chr(34),"&quot;")		'双引号
	Strer=Replace(strer,Chr(33),"&nbsp;")		'空格
	Select Case Chtype
	Case 1
		Strer=Replace(Strer,Chr(9),"&nbsp;")		'table
		'Strer=Replace(Strer,VbCrlf,"")			'回车
		Strer=Replace(Strer,"{$download_dir}",InstallDir&UploadSetting(1))
		Strer=Replace(Strer,Chr(10),"")
		Strer=Replace(Strer,Chr(13),"")
	Case 2
		Strer=Replace(Strer,Chr(9),"&nbsp;　&nbsp;")	'table
		'Strer=Replace(Strer,VbCrlf,"<br \>")		'回车
		Strer=Replace(Strer,Chr(10),"<br \>")
		Strer=Replace(Strer,Chr(13),"")
	End Select
	Code_Html=Strer
End Function

'过滤不健康的字符串
Public Function Code_Health(ByVal Strer)
	Dim i,BadWords,iBadWords,lBadWords,rBadWords
	Code_Health=Strer
	If Not IsHealth Then Exit Function
	BadWords=Split(Web_BadWords,"|")
	For i=0 To Ubound(BadWords)
		iBadWords=Split(BadWords(i),"=")
		lBadWords=iBadWords(0)
		rBadWords=iBadWords(1)
		Code_Health=Replace(Code_Health,lBadWords,rBadWords)
	Next
	Erase BadWords
End Function

'能识别中文字的通用字符分割器(取指定长度的字符，标题显示用）OK
'Types      为输入的待分割字符
'Num        为分割的长(字节数，中文为２字节),左起第几个
Public Function Cuted(ByVal Types,ByVal Num)
	If Is_null(Types) = "" Or Types = "" Then
		Cuted = ""
		Exit Function
	Else
		If Str_Length(Types) > Cint(Num) Then
			Types = Str_Left(Types,Cint(Num))
			Cuted = Types & "..."
		Else
			Cuted = Types
		End If
	End If
End Function

'能识别中文字的left(),中文为２字节 OK
'Strers   为原字符串
'Num     为需要(左)截取的位数
Public Function Str_Left(ByVal Strers,ByVal Num)
	Dim Temp_Str, Test_Str, Lens, i
	Temp_Str = Len(Strers)
	For i = 1 To Temp_Str
		Test_Str = Mid(Strers, i, 1)
		Str_Left = Str_Left & Test_Str
		If Asc(Test_Str) > 0 Then
			Lens = Lens + 1
		Else
			Lens = Lens + 2
		End If
		If Lens >= Cint(Num) Then
			Exit For
		End If
	Next
End Function

'能识别中文字的len(),中文为２ OK
'Strers    为待检测长度的字符串
Public Function Str_Length(ByVal Strers)
	On Error Resume Next
	Dim Winnt_Chinese
	Winnt_Chinese = (Len("中国") = 2)
	If Winnt_Chinese = True Then
		Dim LNum, TNum, CNum, i
		LNum = Len(Strers)
		TNum = LNum
		For i = 1 To LNum
			CNum = Asc(Mid(Strers, i, 1)) '返回字符的代码值
			If CNum < 0 Then
				CNum = CNum + 65536
			End If
			If CNum > 255 Then
				TNum = TNum + 1
			End If
		Next
		Str_Length = TNum
	Else
		Str_Length = Len(Strers)
	End If
	If Err.Number <> 0 Then
		Err.Clear()
	End If
End Function

Function Check(InString)
	regEx.Pattern = "(^|,)(\d+),(.*,)?(\2)(?:,|$)"     '匹配有重复数字的正则表达式
	If regEx.test(InString) Then     '验证是否有重复数字
		OutStr = regEx.Replace(InString,"$1$2,$3")     '过滤
		Check = Check(OutStr)     '递归并返回过滤的中间结果
	Else
		regEx.Pattern = ",$"     '匹配最后逗号的正则表达式
		OutStr = regEx.Replace(InString,"")     '去掉最后的逗号
		Check = OutStr     '返回过滤的最后结果
	End If
End Function

Function FilterStr(Byval Str,Byval FilterType)
	if IsNul(Str) then  FilterStr="" : Exit Function
	dim outstr,rulestr
	Select case FilterType
	case "html"	
		rulestr="(<[a-zA-Z].*?>)|(<[\/][a-zA-Z].*?>)"
	case "jsiframe"
		rulestr="(<(script|iframe).*?>)|(<[\/](script|iframe).*?>)"
	end Select
	regEx.Pattern=rulestr
	outstr=regEx.Replace(Str, "")
	FilterStr=outstr
End Function

'=================================================
'过程名：ShiftCharacterSave
'作  用：替换标签为图片显示
'参  数：要替换的数据    Content
'=================================================
Function ShiftCharacterSave(Content)
	Dim strTemp, strTemp2
	regEx.Pattern = "\<IMG(.[^\<]*)\}['|""]>"
	Set Matches = regEx.Execute(Content)
	
	For Each Match In Matches
		regEx.Pattern = "\{\$(.*?)\}"
		Set strTemp = regEx.Execute(Match.value)
		
		For Each Match2 In strTemp
			strTemp2 = Replace(Match2.value, "?", """")
			Content = Replace(Content, Match.value, "<!--" & strTemp2 & "-->")
		Next
	Next
	
	'处理图片JS标签代码
	regEx.Pattern = "\<IMG(.[^\<]*)\$\>"
	Set Matches = regEx.Execute(Content)

	For Each Match In Matches
		regEx.Pattern = "\#(.*?)\#"
		Set strTemp = regEx.Execute(Match.value)
		
		For Each Match2 In strTemp
			strTemp2 = Replace(Match2.value, "?", "?")
			strTemp2 = Replace(strTemp2, "&amp;", "&")
			strTemp2 = Replace(strTemp2, "&13;&10;", "vbCrLf")
			strTemp2 = Replace(strTemp2, "&9;", "vbTab")
			strTemp2 = Replace(strTemp2, "[!", "<")
			strTemp2 = Replace(strTemp2, "!]", ">")
			Content = Replace(Content, Match.value, strTemp2)
		Next
	Next
	
	'处理编辑器问题
	Content = Replace(Content,"<DIV","<div")
	Content = Replace(Content,"</DIV>",vbCrLf & "</div>"& vbCrLf)
	Content = Replace(Content,"<DD>",vbCrLf & "<dd>")
	Content = Replace(Content,"<DT>",vbCrLf & "<dt>")
	Content = Replace(Content,"<DL>",vbCrLf & "<dl>")
	Content = Replace(Content,"</DD>",vbCrLf & "</dd>"& vbCrLf)
	Content = Replace(Content,"</DT>",vbCrLf & "</dt>"& vbCrLf)
	Content = Replace(Content,"</DL>",vbCrLf & "</dl>"& vbCrLf)
	Content = Replace(Content,"<TABLE","<table")
	Content = Replace(Content,"</TABLE>",vbCrLf & "</table>"& vbCrLf)
	Content = Replace(Content,"<TBODY>","")
	Content = Replace(Content,"</TBODY>","" & vbCrLf)
	Content = Replace(Content,"<TR","<tr")
	Content = Replace(Content,"</TR>",vbCrLf & "</tr>"& vbCrLf)
	Content = Replace(Content,"<TD","<td")
	Content = Replace(Content,"</TD>","</td>")
	Content = Replace(Content,"<SELECT",vbCrLf & "<Select")
	Content = Replace(Content,"</SELECT>",vbCrLf & "</Select>")
	Content = Replace(Content,"<OPTION",vbCrLf & "  <Option")
	Content = Replace(Content,"</OPTION>","</Option>")
	Content = Replace(Content,"<INPUT",vbCrLf & "  <Input")
	Content = Replace(Content,"<SCRIPT","<Script")
	Content = Replace(Content,"</SCRIPT>","</Script>")
	Content = Replace(Content,"&amp;","&")
	Content = Replace(Content,Chr(10),vbCrLf)
	Content = Replace(Content,Chr(9),"	")

	'解决编辑器过滤为标签值为空问题
	regEx.Pattern = "(\s)+(value|title|src|href)(\s)*\=(\s)*\{\$(.[^\<\{]*)\}"
	Set Matches = regEx.Execute(Content)

	For Each Match In Matches
		strTemp = Replace(Trim(Match.value), "{$", """{$")
		strTemp = Replace(strTemp, "}", "}""")
		Content = Replace(Content, Match.value, " " & strTemp)
	Next
	ShiftCharacterSave = Content
End Function

'--- 模板调用 ---
Private Function Template(ByVal Mobanid,ByVal Skinid,ByVal IsHtml)
	Dim TmpCls, Cid
	Set TmpCls = New Cls_FileSystem
	If TmpCls.Chk_Exist(InstallDir&TemplateDir&Mobanid,1)=False And Mobanid="Index.html" Then
		HtmlContent = HtmlContent & "<!DOCTYPE html>" & vbCrLf
		HtmlContent = HtmlContent & "<head>" & vbCrLf
		HtmlContent = HtmlContent & "<meta http-equiv='Content-Type' content='text/html; charset=utf-8'>" & vbCrLf
		HtmlContent = HtmlContent & "<title>" & SiteTitle & " - " & Tit & " - " & SiteKeywords & "</title>" & vbCrLf
		HtmlContent = HtmlContent & "</head>" & vbCrLf
		HtmlContent = HtmlContent & "<body>" & vbCrLf
		HtmlContent = HtmlContent & "<script language=""JavaScript"" type=""text/JavaScript"">" & vbCrLf
		If Web_IsCreatIndexShow=True Then
			HtmlContent = HtmlContent & "location.href=""" & InstallDir & Web_IndexShowFile & """;" & vbCrLf
		Else
			HtmlContent = HtmlContent & "location.href=""" & InstallDir & IndexShow & """;" & vbCrLf
		End If
		HtmlContent = HtmlContent & "</script>" & vbCrLf
		HtmlContent = HtmlContent & "</body>" & vbCrLf
		HtmlContent = HtmlContent & "</html>"
		HtmlContent = HtmlContent & vbCrLf & CHR(60)&CHR(115)&CHR(112)&CHR(97)&CHR(110)&CHR(32)&CHR(115)&CHR(116)&CHR(121)&CHR(108)&CHR(101)&CHR(61)&CHR(34)&CHR(100)&CHR(105)&CHR(115)&CHR(112)&CHR(108)&CHR(97)&CHR(121)&CHR(58)&CHR(110)&CHR(111)&CHR(110)&CHR(101)&CHR(59)&CHR(34)&CHR(62)&CHR(80)&CHR(117)&CHR(98)&CHR(108)&CHR(105)&CHR(115)&CHR(104)&CHR(101)&CHR(100)&CHR(32)&CHR(97)&CHR(116)&CHR(32)&Now()&CHR(44)&CHR(32)&CHR(80)&CHR(111)&CHR(119)&CHR(101)&CHR(114)&CHR(101)&CHR(100)&CHR(32)&CHR(66)&CHR(121)&CHR(32)&CHR(87)&CHR(97)&CHR(110)&CHR(103)&CHR(75)&CHR(97)&CHR(105)&CHR(67)&CHR(77)&CHR(83)&CHR(32)&SystemEdition&CHR(32)&CHR(118)&SystemVersion&CHR(40)&Replace(Replace(Replace(SystemDatabaseType,0,"ACCESS"),1,"MSSQL"),2,"MYSQL")&CHR(41)&CHR(32)&SystemBuildDate&CHR(32)&CHR(40)&Charset&CHR(41)&CHR(60)&CHR(47)&CHR(115)&CHR(112)&CHR(97)&CHR(110)&CHR(62)
	Else
		If TmpCls.Chk_Exist(InstallDir&TemplateDir&Mobanid,1)=False Then
			HtmlContent = HtmlContent & "<!DOCTYPE html>" & vbCrLf
			HtmlContent = HtmlContent & "<head>" & vbCrLf
			HtmlContent = HtmlContent & "<meta http-equiv='Content-Type' content='text/html; charset=utf-8'>" & vbCrLf
			HtmlContent = HtmlContent & "<title>" & SiteTitle & " - " & Tit & " - " & SiteKeywords & "</title>" & vbCrLf
			HtmlContent = HtmlContent & "<script type='text/javascript' src='" & InstallDir & "Dialog/main.js'></script>" & vbCrLf
			HtmlContent = HtmlContent & "</head>" & vbCrLf
			HtmlContent = HtmlContent & "<body>" & vbCrLf
			HtmlContent = HtmlContent & "<script language=""JavaScript"" type=""text/JavaScript"">" & vbCrLf
			HtmlContent = HtmlContent & "Dialog.alert(""网站模板文件无法调用或已经删除！"",function(){window.opener=null;window.open("""",""_self"");window.close();});" & vbCrLf
			HtmlContent = HtmlContent & "</script>" & vbCrLf
			HtmlContent = HtmlContent & "</body>" & vbCrLf
			HtmlContent = HtmlContent & "</html>"
			HtmlContent = HtmlContent & vbCrLf & CHR(60)&CHR(115)&CHR(112)&CHR(97)&CHR(110)&CHR(32)&CHR(115)&CHR(116)&CHR(121)&CHR(108)&CHR(101)&CHR(61)&CHR(34)&CHR(100)&CHR(105)&CHR(115)&CHR(112)&CHR(108)&CHR(97)&CHR(121)&CHR(58)&CHR(110)&CHR(111)&CHR(110)&CHR(101)&CHR(59)&CHR(34)&CHR(62)&CHR(80)&CHR(117)&CHR(98)&CHR(108)&CHR(105)&CHR(115)&CHR(104)&CHR(101)&CHR(100)&CHR(32)&CHR(97)&CHR(116)&CHR(32)&Now()&CHR(44)&CHR(32)&CHR(80)&CHR(111)&CHR(119)&CHR(101)&CHR(114)&CHR(101)&CHR(100)&CHR(32)&CHR(66)&CHR(121)&CHR(32)&CHR(87)&CHR(97)&CHR(110)&CHR(103)&CHR(75)&CHR(97)&CHR(105)&CHR(67)&CHR(77)&CHR(83)&CHR(32)&SystemEdition&CHR(32)&CHR(118)&SystemVersion&CHR(40)&Replace(Replace(Replace(SystemDatabaseType,0,"ACCESS"),1,"MSSQL"),2,"MYSQL")&CHR(41)&CHR(32)&SystemBuildDate&CHR(32)&CHR(40)&Charset&CHR(41)&CHR(60)&CHR(47)&CHR(115)&CHR(112)&CHR(97)&CHR(110)&CHR(62)
		Else
			HtmlContent = HtmlContent & LoadFile(InstallDir&TemplateDir&Mobanid)
			HtmlContent = HtmlContent & vbCrLf & CHR(60)&CHR(115)&CHR(112)&CHR(97)&CHR(110)&CHR(32)&CHR(115)&CHR(116)&CHR(121)&CHR(108)&CHR(101)&CHR(61)&CHR(34)&CHR(100)&CHR(105)&CHR(115)&CHR(112)&CHR(108)&CHR(97)&CHR(121)&CHR(58)&CHR(110)&CHR(111)&CHR(110)&CHR(101)&CHR(59)&CHR(34)&CHR(62)&CHR(80)&CHR(117)&CHR(98)&CHR(108)&CHR(105)&CHR(115)&CHR(104)&CHR(101)&CHR(100)&CHR(32)&CHR(97)&CHR(116)&CHR(32)&Now()&CHR(44)&CHR(32)&CHR(80)&CHR(111)&CHR(119)&CHR(101)&CHR(114)&CHR(101)&CHR(100)&CHR(32)&CHR(66)&CHR(121)&CHR(32)&CHR(87)&CHR(97)&CHR(110)&CHR(103)&CHR(75)&CHR(97)&CHR(105)&CHR(67)&CHR(77)&CHR(83)&CHR(32)&SystemEdition&CHR(32)&CHR(118)&SystemVersion&CHR(40)&Replace(Replace(Replace(SystemDatabaseType,0,"ACCESS"),1,"MSSQL"),2,"MYSQL")&CHR(41)&CHR(32)&SystemBuildDate&CHR(32)&CHR(40)&Charset&CHR(41)&CHR(60)&CHR(47)&CHR(115)&CHR(112)&CHR(97)&CHR(110)&CHR(62)
			HtmlContent = ReplaceHtml(HtmlContent)
			HtmlContent = Html.ReplaceCommonLabel()
			HtmlContent = Html.ReadClass(HtmlContent)
			HtmlContent = Html.ReadClassName(HtmlContent)
			HtmlContent = Html.ReadChannelList(HtmlContent)
			HtmlContent = Html.ReadChannelPic(HtmlContent)
			HtmlContent = Html.ReadChannelFlash(HtmlContent)
			HtmlContent = Html.ReadChannelFlashqq(HtmlContent)
			HtmlContent = Html.makeContentImages(HtmlContent)
			Html.ParseLoop()
			Html.parseList Cid,CurrentPage,Keyword
			Html.EnSql()
			Html.parseAuxiliaryTemplate()
			Html.ParseIf()
			HtmlContent = Replace(HtmlContent,"{$DefaultSkin}","{$InstallDir}{$SkinDir}"&Skinid,1,-1,1)
			HtmlContent = ReHtml(HtmlContent)
		End If
	End If
	If IsHtml Then
		Template = HtmlContent
	Else
		Response.Write HtmlContent
	End If
End Function

'--- 模型模板调用 ---
Private Function ChannelTemplate(ByVal Mobanid,ByVal Skinid,ByVal sChannelID)
	Dim TmpCls, Cid, ChannelMobanDirs
	If sChannelID > 0 Then
		Call GetChannel(sChannelID)
	End If
	If ChannelDir<>"" Then
		ChannelMobanDirs = ChannelDir&"/"
	End If
	Set TmpCls = New Cls_FileSystem
	If TmpCls.Chk_Exist(InstallDir&TemplateDir&ChannelMobanDirs&Mobanid,1)=False Then
		HtmlContent = HtmlContent & "<!DOCTYPE html>" & vbCrLf
		HtmlContent = HtmlContent & "<head>" & vbCrLf
		HtmlContent = HtmlContent & "<meta http-equiv='Content-Type' content='text/html; charset=utf-8'>" & vbCrLf
		HtmlContent = HtmlContent & "<title>" & SiteTitle & " - " & Tit & " - " & SiteKeywords & "</title>" & vbCrLf
		HtmlContent = HtmlContent & "<script type='text/javascript' src='" & InstallDir & "Dialog/main.js'></script>" & vbCrLf
		HtmlContent = HtmlContent & "</head>" & vbCrLf
		HtmlContent = HtmlContent & "<body>" & vbCrLf
		HtmlContent = HtmlContent & "<script language=""JavaScript"" type=""text/JavaScript"">" & vbCrLf
		HtmlContent = HtmlContent & "Dialog.alert(""网站模板文件无法调用或已经删除！"",function(){window.opener=null;window.open("""",""_self"");window.close();});" & vbCrLf
		HtmlContent = HtmlContent & "</script>" & vbCrLf
		HtmlContent = HtmlContent & "</body>" & vbCrLf
		HtmlContent = HtmlContent & "</html>"
		HtmlContent = HtmlContent & vbCrLf & CHR(60)&CHR(115)&CHR(112)&CHR(97)&CHR(110)&CHR(32)&CHR(115)&CHR(116)&CHR(121)&CHR(108)&CHR(101)&CHR(61)&CHR(34)&CHR(100)&CHR(105)&CHR(115)&CHR(112)&CHR(108)&CHR(97)&CHR(121)&CHR(58)&CHR(110)&CHR(111)&CHR(110)&CHR(101)&CHR(59)&CHR(34)&CHR(62)&CHR(80)&CHR(117)&CHR(98)&CHR(108)&CHR(105)&CHR(115)&CHR(104)&CHR(101)&CHR(100)&CHR(32)&CHR(97)&CHR(116)&CHR(32)&Now()&CHR(44)&CHR(32)&CHR(80)&CHR(111)&CHR(119)&CHR(101)&CHR(114)&CHR(101)&CHR(100)&CHR(32)&CHR(66)&CHR(121)&CHR(32)&CHR(87)&CHR(97)&CHR(110)&CHR(103)&CHR(75)&CHR(97)&CHR(105)&CHR(67)&CHR(77)&CHR(83)&CHR(32)&SystemEdition&CHR(32)&CHR(118)&SystemVersion&CHR(40)&Replace(Replace(Replace(SystemDatabaseType,0,"ACCESS"),1,"MSSQL"),2,"MYSQL")&CHR(41)&CHR(32)&SystemBuildDate&CHR(32)&CHR(40)&Charset&CHR(41)&CHR(60)&CHR(47)&CHR(115)&CHR(112)&CHR(97)&CHR(110)&CHR(62)
	Else
		HtmlContent = HtmlContent & LoadFile(InstallDir&TemplateDir&ChannelMobanDirs&Mobanid)
		HtmlContent = HtmlContent & vbCrLf & CHR(60)&CHR(115)&CHR(112)&CHR(97)&CHR(110)&CHR(32)&CHR(115)&CHR(116)&CHR(121)&CHR(108)&CHR(101)&CHR(61)&CHR(34)&CHR(100)&CHR(105)&CHR(115)&CHR(112)&CHR(108)&CHR(97)&CHR(121)&CHR(58)&CHR(110)&CHR(111)&CHR(110)&CHR(101)&CHR(59)&CHR(34)&CHR(62)&CHR(80)&CHR(117)&CHR(98)&CHR(108)&CHR(105)&CHR(115)&CHR(104)&CHR(101)&CHR(100)&CHR(32)&CHR(97)&CHR(116)&CHR(32)&Now()&CHR(44)&CHR(32)&CHR(80)&CHR(111)&CHR(119)&CHR(101)&CHR(114)&CHR(101)&CHR(100)&CHR(32)&CHR(66)&CHR(121)&CHR(32)&CHR(87)&CHR(97)&CHR(110)&CHR(103)&CHR(75)&CHR(97)&CHR(105)&CHR(67)&CHR(77)&CHR(83)&CHR(32)&SystemEdition&CHR(32)&CHR(118)&SystemVersion&CHR(40)&Replace(Replace(Replace(SystemDatabaseType,0,"ACCESS"),1,"MSSQL"),2,"MYSQL")&CHR(41)&CHR(32)&SystemBuildDate&CHR(32)&CHR(40)&Charset&CHR(41)&CHR(60)&CHR(47)&CHR(115)&CHR(112)&CHR(97)&CHR(110)&CHR(62)
		HtmlContent = ReplaceHtml(HtmlContent)
		HtmlContent = Html.ReplaceCommonLabel()
		HtmlContent = Html.makeContentImages(HtmlContent)
		Html.ParseLoop()
		Html.parseList Cid,CurrentPage,Keyword
		Html.EnSql()
		Html.parseAuxiliaryTemplate()
		Html.ParseIf()
		HtmlContent = Replace(HtmlContent,"{$DefaultSkin}","{$InstallDir}{$SkinDir}"&Skinid,1,-1,1)
		HtmlContent = ReHtml(HtmlContent)
	End If
	ChannelTemplate = HtmlContent
End Function

'//* 替换处理 *// 
Function ReplaceStr(Byval str,Byval finStr,Byval repStr)
	on error resume next
	if IsNull(repStr) then repStr=""
	ReplaceStr=replace(str,finStr,repStr)
	if err then ReplaceStr="" : err.clear
End Function

'//* 字符类型处理 *//  
Public Function ChkBoolean(ByVal Values)
	If TypeName(Values) = "Boolean" Or IsNumeric(Values) Or LCase(Values) = "false" Or LCase(Values) = "true" Then
		ChkBoolean = CBool(Values)
	Else
		ChkBoolean = False
	End If
End Function

Public Function CheckNumeric(ByVal CHECK_ID)
	If CHECK_ID <> "" And IsNumeric(CHECK_ID) Then
		CHECK_ID = CCur(CHECK_ID)
	Else
		CHECK_ID = 0
	End If
	CheckNumeric = CHECK_ID
End Function

Public Function ChkNumeric(ByVal CHECK_ID)
	If CHECK_ID <> "" And IsNumeric(CHECK_ID) Then
		CHECK_ID = CLng(CHECK_ID)
		If CHECK_ID < 0 Then CHECK_ID = 0
	Else
		CHECK_ID = 0
	End If
	ChkNumeric = CHECK_ID
End Function

Public Function CheckStr(ByVal str)
	If IsNull(str) Then
		CheckStr = ""
		Exit Function
	End If
	str = Replace(str, Chr(0), "")
	CheckStr = Replace(str, "'", "''")
End Function

Public Function Get_Frist_Pic(byval t0)
	Get_Frist_Pic=""
	if len(t0)=0 then exit function
	regEx.pattern="<img[^>]+src=""([^"">]+)""[^>]*>"
	set matches=regEx.execute(t0)
	if regEx.test(t0) then
	   Get_Frist_Pic=matches(0).submatches(0)
	end if
End Function

Function cn_split(str, x)
	Dim a, b
	Dim i, j, flag, max, temp_str
	Dim MyFso,TxtContent
	Set MyFso=Fso.OpenTextFile(Server.mappath(InstallDir&"DataBase/Keyword.txt"))
	TxtContent=MyFso.ReadAll
	b="|" & Replace(TxtContent,vbcrlf,"|") & "|"
	Set MyFso=nothing
	Set Fso=nothing
	a =str
	'分词
	For i = 1 To Len(a)
		For j = 2 To x
			a = a & Mid(a, i, j) & " "
		Next
	Next
	a = Split(a, " ")
	'b = Split(b, " ")
	max = UBound(a)
	'过滤重复字符串
	For i = 0 To max - 1
		flag = a(i)
		'If iscn(flag) Then
			For j = i + 1 To max - 1
				If a(j) = flag And flag <> "" Then
					a(j) = ""
				End If
			Next
			If a(i) <> "" Then
				temp_str = temp_str & a(i) & " "
			End If
	   'End If
	Next
	a = Split(temp_str, " ")
	temp_str = ""
	For i=0 to Ubound(a)
		If Instr(b,"|" & a(i) & "|")<>0 Then
			temp_str =temp_str  & a(i) &  " "
			'If len(temp_str)>maxlen and maxlen<>0 then exit for
		End If
	Next
	cn_split=replace(trim(temp_str)," ",",")
End Function

Function iscn(str)
	Dim i
	i = Len(str)
	If i = 0 Then
		iscn = False
		Exit Function
	End If

	Do While i > 0
		If Asc(Mid(str, i, 1)) < 10000 And Asc(Mid(str, i, 1)) > -10000 Then
			iscn = False
			Exit Function
		End If
		i = i - 1
	Loop
	iscn = True
End Function

'//* 字符串处理 *//
'-- 判断字符串是否为空
Public Function Is_Null(ByVal sVal)
	Is_Null=Trim(sVal)
	If Is_Null="" Or IsNull(Is_Null) Or IsEmpty(Is_Null) Then Is_Null=""
End Function

'获取字符串长度
Function StrLen(byval t0)
	If IsNull(t0) Then StrLen=0:Exit Function
	StrLen=Len(t0)
End Function

'是否为空
Function IsNul(ByVal Str)
	If IsNull(Str) Or IsEmpty(Str) Or Str="" Then IsNul=True Else IsNul=False
End Function

'是否为数字
Function IsNum(Str)
	If Not IsNul(Str) Then IsNum=IsNumeric(Str) Else IsNum=False
End Function

'在Str中是否存在Findstr
Function isExistStr(ByVal Str,ByVal Findstr)
	if isNul(Str) Or isNul(Findstr) Then isExistStr=False:Exit Function
	If Instr(Str,Findstr)>0 Then isExistStr=True Else isExistStr=False
End Function

Function IsInstall(ByVal Str)
	err.clear
	on error resume next
	isinstall=false
	dim obj
	set obj=server.createobject(Str)
		if err.number=0 then isinstall=true
	set obj=nothing
	err.clear()
End Function

Function IsFile(ByVal Str)
	on error resume next
	IsFile=Fso.fileexists(server.mappath(Str))
	if err then
		err.clear
		IsFile=false
	end if
End Function

Public Function Is_Pic(ByVal Str)
	if isnull(Str) or len(Str)=0 then Is_Pic=0:exit function
	if instr(Str,".")<0 then Is_Pic=0:exit function
	if len(Str)<4 then Is_Pic=0:exit function
	select case lcase(right(Str,3))
		case "gif","jpg","jpeg","bmp","png":Is_Pic=1
		case else:Is_Pic=0
	end select
End Function

Public Function Is_Video(byval t0)
	if isnull(t0) or len(t0)=0 then Is_Video="other":exit function
	if instr(t0,".")<0 then Is_Video="other":exit function
	if len(t0)<4 then Is_Video="other":exit function
	if instr(lcase(t0),".swf")>0 and instr(lcase(t0),"http://") then Is_Video="swf":exit function
	select case lcase(right(t0,3))
		case "flv":Is_Video="flv"
		case "swf":Is_Video="swf"
		case "mp4":Is_Video="mp4"
		case else:Is_Video="other"
	end select
End Function

Public Function insert(byval t0,byval t1)
	dim dbfield,dbvalue,dbarray,i,temparr,fieldlen,filedtype,sqlvalue
	dbfield=""
	dbvalue=""
	dbarray=t1
	filedtype=""
	for i=0 to ubound(dbarray)
		temparr=dbarray(i)
		if len(dbfield)>0 then
			dbfield=dbfield&","
			dbvalue=dbvalue&","
		end if
		if instr(temparr(0),"(")>0 or instr(temparr(0),")")>0 or instr(temparr(0)," ")>0 or instr(temparr(0),".")>0 then
			dbfield=dbfield&temparr(0)
		else
			dbfield=dbfield&"["&temparr(0)&"]"
		end if
		fieldlen=temparr(2)
		filedtype=temparr(3)
		sqlvalue=replace(temparr(1),"'","''")
		if fieldlen=0 then
			if filedtype=1 then
				dbvalue=dbvalue&"'"&sqlvalue&"'"
			else
				dbvalue=dbvalue&sqlvalue
			end if
		else
			if filedtype=1 then
				dbvalue=dbvalue&"'"&left(sqlvalue,fieldlen)&"'"
			else
				dbvalue=dbvalue&left(sqlvalue,fieldlen)
			end if
		end if
	next
	Call Exec("","insert into "&t0&" ("&dbfield&") values ("&dbvalue&")",0)
End Function

Public Function dbnew(byval t0,byval t1,byval t2)
	dim dbfield,dbvalue,dbnum,dbarray,i,temparr,fieldlen,sqlvalue
	dbfield=""
	dbvalue=""
	dbarray=t1
	dbnew=0
	dbnum=ubound(dbarray)
	if len(t2)>0 then t2="where "&t2
	dim fieldarr(999)
	for i=0 to dbnum
		temparr=dbarray(i)
		if len(dbfield)>0 then
			dbfield=dbfield&","
		end if
		fieldlen=temparr(2)
		sqlvalue=temparr(1)
		if fieldlen=0 then
			fieldarr(i)=sqlvalue
		else
			fieldarr(i)=left(sqlvalue,fieldlen)
		end if
		if instr(temparr(0),"(")>0 or instr(temparr(0),")")>0 or instr(temparr(0)," ")>0 or instr(temparr(0),".")>0 then
			dbfield=dbfield&temparr(0)
		else
			dbfield=dbfield&"["&temparr(0)&"]"
		end if
	next
	Call Exe_Conn(rs,"select "&dbfield&" from "&t0&" "&t2&"",3)
	if len(t2)>0 then
		if not rs.eof then
			rs.close
			set rs=nothing
			exit function
		end if
	end if
	rs.addnew
	for i=0 to dbnum
		rs(i)=fieldarr(i)
	next
	rs.update
	rs.close
	set rs=nothing
	dbnew=1
End Function

Public Function dbupdate(byval t0,byval t1,byval t2)
	dbupdate=0
	dim i,dbarray,sqlvalue
	dim n1,n2,n3,n4
	dbarray=t2
	sqlvalue=""
	for i=0 to ubound(dbarray)
		if len(sqlvalue)>0 then
			sqlvalue=sqlvalue&","
		end if
		 n1=dbarray(i)(0)
		 n2=dbarray(i)(1)
		 n3=dbarray(i)(2)
		 n4=dbarray(i)(3)
		 if n3<>0 then n2=left(n2,n3)
		 if n4=1 then n2=sdcms.sqlstr(n2)
		 if instr(n1,"(")>0 or instr(n1,")")>0 or instr(n1," ")>0 or instr(n1,".")>0 then
			  sqlvalue=sqlvalue&n1&"="&n2&""
		 else
			sqlvalue=sqlvalue&"["&n1&"]="&n2&""
		 end if
	next
	dim sql
	sql="update "&t0&" set "&sqlvalue
	if len(t1)>0 then sql=sql&" where "&t1
	Call Exec("",sql,0)
	dbupdate=1
End Function

Public Function dbload(byval t0,byval t1,byval t2,byval t3,byval t4)
	if len(t0)>0 then t0=" top "&t0
	if len(t1)=0 then t1=" * "
	if len(t3)>0 then t3=" where "&t3
	if left(lcase(t4),3)="rnd" then
		if datatype then
			randomize
			dim orderid
			if len(t4)>4 then orderid=right(t4,len(t4)-4)
			if len(orderid)=0 then orderid="id"
			t4="rnd(-("&orderid&" +"&rnd()&"))"
		else
			t4="newid()"
		end if
	end if
	if len(t4)>0 then t4=" order by "&t4
	if t1<>" * " then
		dim str:str=""
		dim arr:arr=split(t1,",")
		dim i
		for i=0 to ubound(arr)
			if i>0 then str=str&","
			if instr(arr(i),"(")>0 or instr(arr(i),")")>0 or instr(arr(i)," ")>0 or instr(arr(i),".")>0 then
				str=str&arr(i)
			else
				str=str&"["&arr(i)&"]"
			end if
		next
		t1=str
	end if
	set rs=Exec("","select "&t0&" "&t1&" from "&t2&" "&t3&" "&t4,1)
	if rs.eof then
		dbload=array()
	else
		dbload=rs.getrows()
	end if
	rs.close
	set rs=nothing
End Function

Public Function dbloadone(byval t0,byval t1,byval t2)
	if len(t2)>0 then t2=" where "&t2
	dbloadone=Exec("","select "&t0&" from "&t1&" "&t2&"",1)(0)
End Function

Public Function dbdel(byval t0,byval t1)
	dim sql
	sql="delete from "&t0
	if len(t1)>0 then sql=sql&" where "&t1
	Call Exec("",sql,0)
End Function

Public Function dbcount(byval t0,byval t1)
	dim sql
	sql="select count(1) from "&t0
	if len(t1)>0 then sql=sql&" where "&t1
	dbcount=Exec("",sql,1)(0)
End Function

Public Function insertid(byval t0,byval t1)
	'if SystemDatabaseType = 0 then
		insertid=Exec("","select max("&t0&") from "&t1&"",1)(0)
	'else
		'insertid=Exec("","select @@identity",1)
	'end if
End Function

Public Function insertid_new(byval t0,byval t1,byval t2)
	if len(t2)>0 then t2=" where "&t2
	insertid_new=Exec("","select max("&t0&") from "&t1&" "&t2&"",1)(0)
End Function

Public Function deal_file(byval t0,byval t1)
	dbupdate "Attachment","adminid="&t0&" and cid<=0 and classid="&t1&"",array(array("cid",t1,0,0))
End Function

Public Function deal_del_file(byval t0,byval t1)
	dbupdate "Attachment","cid="&t0&" and classid="&t1&"",array(array("cid",-1,0,0))
End Function

public function getnum(byval t0)
	getnum=formatnumber(t0,2,true,false,true)
End Function

Public Function getip()
	getip=request.servervariables("HTTP_X_FORWARDED_FOR")
	if getip="" then getip=request.servervariables("REMOTE_ADDR")
	if not(checkget(getip,"ip")) then getip="unknow"
End Function

Public Function checkget(byval t0,byval t1)
	dim t2
	select case t1
		case "null":checkget=is_null(t0):exit function
		case "en":t2="^[a-zA-Z]+$"
		case "cn":t2="^[\u4e00-\u9fa5]+$"
		case "int":t2="^[-\+]?\d+$"
		case "price":t2="^\d+(\.\d+)?$"
		case "username":t2="^[a-zA-Z0-9_]{5,20}$"
		case "password":t2="^[a-zA-Z0-9.]{6,16}$"
		case "email":t2="^[\w\-\.]+@[a-zA-Z0-9]+\.(([a-zA-Z0-9]{2,4})|([a-zA-Z0-9]{2,4}\.[a-zA-Z]{2,4}))$"
		case "date":checkget=isdate(t0):exit function
		case "qqemail":t2="^[\w\-\.]+@qq.com"
		case "tel":t2="^((\(\+?\d{2,3}\))|(\+?\d{2,3}\-))?(\(0?\d{2,3}\)|0?\d{2,3}-)?[1-9]\d{4,7}(\-\d{1,4})?$"
		case "mobile":t2="^(\+?\d{2,3})?0?1(3\d|5\d|7[0]|8[0256789])\d{8}$"
		case "zipcode":t2="^\d{6}$"
		case "qq":t2="^[1-9]\d{4,15}$"
		case "url":t2 = "^(http|https|ftp):\/\/[a-zA-Z0-9]+\.[a-zA-Z0-9]+[\/=\?%\-&_~`@[\]\':+!]*([^<>\""])*$"
		case "ip":t2="^((25[0-5]|2[0-4]\d|(1\d|[1-9])?\d)\.){3}(25[0-5]|2[0-4]\d|(1\d|[1-9])?\d)$"
		case "file":t2="^[a-zA-Z0-9/_-]{1,50}$"
		case "filename":t2="^[a-zA-Z0-9._/]{1,50}$"
		case "urlname":t2="^[a-zA-Z0-9]{1,50}$"
	end select
	regEx.pattern=t2
	checkget=regEx.test(trim(t0))
End Function

'makeContentImages附属方法，临时
Function ParseArr(Byval attr)
	dim attrStr,attrArray,attrDictionary,i,singleAttr,singleAttrKey,singleAttrValue
	dim StrDictionary
	
	If Not IsObject(StrDictionary) Then Set StrDictionary=Server.CreateObject("Scripting.Dictionary")
	
	attrStr = RegExpReplace(attr,"[\s]+",chr(32))
	attrStr = trim(attrStr)
	attrArray = split(attrStr,chr(32))
	For i=0 To ubound(attrArray)
		singleAttr = split(attrArray(i),chr(61))
		singleAttrKey = singleAttr(0) : singleAttrValue = singleAttr(1)
		if not StrDictionary.Exists(singleAttrKey) then StrDictionary.add singleAttrKey,singleAttrValue else StrDictionary(singleAttrKey) = singleAttrValue
	Next
	Set ParseArr = StrDictionary
End Function

'makeContentImages附属方法，临时
Function RegExpReplace(contentstr,patternstr,replacestr)
	regEx.Pattern=patternstr
	RegExpReplace=regEx.Replace(contentstr,replacestr)
End Function

'获取当前类下所有子类 allsub 1带父级，0所有最小类
Function getSubSort(ClassID, allsub)
	dim rs, sql
	sql="select (select count(*) from Class where ClassParent="&ClassID&"), * from Class where ClassParent="&ClassID
	Call Exec(rs,sql,2)
	if rs.eof then
		getSubSort=ClassID&","
	else
		if allsub=1 then getSubSort=ClassID&","
		do while not rs.eof
			getSubSort=getSubSort&getSubSort(rs("ClassID"), allsub)
			rs.movenext
		loop
	end if
End Function

'//* 外部发言 *//
'-- 判断发言是否来自外部
Public Function Post_Chk()
	Dim server_v1,server_v2
	server_v1=Request.ServerVariables("HTTP_REFERER")
	server_v2=Request.ServerVariables("SERVER_NAME")
	If server_v1<>"" Then
		'mid(server_v1,8,len(server_v2))=server_v2
		server_v2="http://"&server_v2
		If Left(server_v1,Len(server_v2))=server_v2 Then
			Post_Chk=True
			Exit Function
		End If
	End If
	Post_Chk=False
End Function

Public Function Chk()
	Chk=False
	If Code_Form("chk")="yes" Then
		Chk=Post_Chk()
	End If
End Function

'-- 判断是否为整数类型，返回布尔值
Public Function Is_Int(ByVal sVal)
	Is_Int=True
	If Is_Null(sVal)="" Or Not(IsNumeric(sVal)) Or Instr(sVal,".")>0 Then Is_Int=False
End Function

'-- 判断是否为数字类型，返回布尔值
Public Function Is_Num(ByVal sVal)
	Is_Num=True
	If Is_Null(sVal)="" Or Not(IsNumeric(sVal)) Then Is_Num=False
End Function

'-- 处理 ID 传入值
Public Function Code_Id(ByVal sVal)
	Dim Strer
	Strer=Trim(Request.Querystring(sVal))
	If Not(Is_Int(Strer)) Then Strer=0
	Code_Id=Clng(Strer)
End Function

'-- 处理整数值
Public Function Code_Int(ByVal Strers,ByVal Sint)
	Dim Strer
	Strer=Code_Form(Strers)
	If Not(Is_Int(Strer)) Then
		Code_Int=Sint
		Exit Function
	End If
	Code_Int=Int(Strer)
End Function

'**************************************************
'函数名：Code_CBool
'作  用：将字符转为布尔弄变量
'参  数：strBool---- 字符
'返回值：True/False
'**************************************************
Function Code_CBool(strBool)
	If strBool = True Or LCase(Trim(strBool)) = "true" Or LCase(Trim(strBool)) = "yes" Or Trim(strBool) = "1" Then
		Code_CBool = True
	Else
		Code_CBool = False
	End If
End Function

'**************************************************
'函数名：Code_CLng
'作  用：将字符转为整型数值
'参  数：Str ---- 字符
'返回值：如果传入的参数不是数值，返回0，其他情况返回对应的数值
'**************************************************
Public Function Code_CLng(ByVal Str)
	If IsNumeric(Str) Then
		Code_CLng = CLng(Str)
	Else
		Code_CLng = 0
	End If
End Function

'**************************************************
'函数名：Code_Replace
'作  用：容错替换
'参  数：Expression ---- 主数据
'        Find ---- 被替换的字符
'        ReplaceWith ---- 替换后的字符
'返回值：容错后的替换字符串,如果 ReplaceWith 空字符,被替换的字符 替换成空
'**************************************************
Function Code_Replace(ByVal Expression, ByVal Find, ByVal ReplaceWith)
	If IsNull(Expression) Or IsNull(Find) Then
		Code_Replace = Expression
	ElseIf IsNull(ReplaceWith) Then
		Code_Replace = Replace(Expression, Find, "")
	Else
		Code_Replace = Replace(Expression, Find, ReplaceWith)
	End If
End Function

'**************************************************
'函数名：WK_CDbl
'作  用：将字符转为双精度数值
'参  数：Str ---- 字符
'返回值：如果传入的参数不是数值，返回0，其他情况返回对应的数值
'**************************************************
Function WK_CDbl(ByVal Str)
	If IsNumeric(Str) Then
		WK_CDbl = CDbl(Str)
	Else
		WK_CDbl = 0
	End If
End Function

'**************************************************
'函数名：WK_ConvertBR
'作  用：将文本区域内的<BR>替换换行
'参  数：fString ---- 要处理的字符串
'返回值：处理后的字符串
'**************************************************
Function WK_ConvertBR(ByVal fString)
	If IsNull(fString) Or Trim(fString) = "" Then
		WK_ConvertBR = ""
		Exit Function
	End If
	fString = Replace(fString, "</P><P>", Chr(10) & Chr(10))
	fString = Replace(fString, "<BR>", Chr(10))
	fString = Replace(fString, "<br>", Chr(10))
	WK_ConvertBR = fString
End Function

'**************************************************
'函数名：WK_HTMLEncode
'作  用：将html 标记替换成 能在IE显示的HTML
'参  数：fString ---- 要处理的字符串
'返回值：处理后的字符串
'**************************************************
Function WK_HTMLEncode(ByVal fString)
	If IsNull(fString) Or Trim(fString) = "" Then
		WK_HTMLEncode = ""
		Exit Function
	End If
	fString = Replace(fString, ">", "&gt;")
	fString = Replace(fString, "<", "&lt;")

	fString = Replace(fString, Chr(32), "&nbsp;")
	fString = Replace(fString, Chr(9), "&nbsp;")
	fString = Replace(fString, Chr(34), "&quot;")
	fString = Replace(fString, Chr(39), "&#39;")
	fString = Replace(fString, Chr(13), "")
	fString = Replace(fString, Chr(10) & Chr(10), "</P><P>")
	fString = Replace(fString, Chr(10), "<BR>")

	WK_HTMLEncode = fString
End Function

'**************************************************
'函数名：WK_CDate
'作  用：将字符转为日期
'参  数：Str ---- 字符
'返回值：如果参数不是日期型字符，则返回当前时间，否则返回对应的日期型数据
'**************************************************
Function WK_CDate(ByVal Str)
	If IsDate(Str) Then
		WK_CDate = CDate(Str)
	Else
		WK_CDate = Now
	End If
End Function

'**************************************************
'函数名：GetMinID
'作  用：取某一表某一字段中的最大值
'参  数：SheetName ----查询表
'        FieldName ----查询字段
'返回值：该字段最小值
'**************************************************
Function GetMinID(SheetName, FieldName)
	Dim mrs
	Call Exec(mrs,"select min(" & FieldName & ") from " & SheetName,2)
	If IsNull(mrs(0)) Then
		GetMinID = 1
	Else
		GetMinID = mrs(0)
	End If
	Set mrs = Nothing
End Function

'**************************************************
'函数名：GetClientName
'作  用：获得客户名称
'参  数：ClientID ---- 客户ID
'返回值：得到客户名称
'**************************************************
Function GetClientName(ClientID)
	If ClientID <= 0 Then
		GetClientName = ""
		Exit Function
	End If
	Dim rsClient
	Call Exec(rsClient,"select ClientName from Client where ClientID=" & ClientID & "",2)
	If rsClient.BOF And rsClient.EOF Then
		GetClientName = ""
	Else
		GetClientName = rsClient(0)
	End If
	rsClient.Close
	Set rsClient = Nothing
End Function

'**************************************************
'函数名：GetContacterName
'作  用：获取用户真实姓名
'参  数：ContacterID ---- 用户详细信息ID
'返回值：得到真实姓名
'**************************************************
Function GetContacterName(ContacterID)
	If ContacterID <= 0 Then
		GetContacterName = ""
		Exit Function
	End If
	Dim rsContacter
	Call Exec(rsContacter,"select TrueName from Contacter where ContacterID=" & ContacterID & "",2)
	If rsContacter.BOF And rsContacter.EOF Then
		GetContacterName = ""
	Else
		GetContacterName = rsContacter(0)
	End If
	rsContacter.Close
	Set rsContacter = Nothing
End Function

'**************************************************
'函数名：GetMobanName
'作  用：获得文件别名
'参  数：MobanName ---- 文件名称
'返回值：得到文件别名
'**************************************************
Function GetMobanName(MobanName)
	If MobanName = "" Then
		GetMobanName = MobanName
		Exit Function
	End If
	Dim rsMoban
	Call Exec(rsMoban,"select MobanGetName from Moban where MobanName='" & MobanName & "'",2)
	If rsMoban.BOF And rsMoban.EOF Then
		GetMobanName = MobanName
	Else
		GetMobanName = rsMoban(0)
	End If
	rsMoban.Close
	Set rsMoban = Nothing
End Function

'**************************************************
'函数名：GetMobanType
'作  用：获得模板类型
'参  数：MobanName ---- 文件名称
'返回值：得到模板类型
'**************************************************
Function GetMobanType(MobanName)
	If MobanName = "" Then
		GetMobanType = MobanName
		Exit Function
	End If
	Dim rsMoban
	Call Exec(rsMoban,"select MobanType from Moban where MobanName='" & MobanName & "'",2)
	If rsMoban.BOF And rsMoban.EOF Then
		GetMobanType = MobanName
	Else
		GetMobanType = rsMoban(0)
	End If
	rsMoban.Close
	Set rsMoban = Nothing
End Function

'**************************************************
'函数名：GetMobanTypeName
'作  用：获得模板类型名称
'参  数：MobanName ---- 文件名称
'返回值：得到模板类型名称
'**************************************************
Function GetMobanTypeName(MobanName)
	If MobanName = "" Then
		GetMobanTypeName = MobanName
		Exit Function
	End If
	Dim rsMoban
	Call Exec(rsMoban,"select MobanType from Moban where MobanName='" & MobanName & "'",2)
	If rsMoban.BOF And rsMoban.EOF Then
		GetMobanTypeName = MobanName
	Else
		If rsMoban(0)=0 Then
			GetMobanTypeName = "导页模版"
		ElseIf rsMoban(0)=1 Then
			GetMobanTypeName = "首页模版"
		ElseIf rsMoban(0)=2 Then
			GetMobanTypeName = "列表页模版"
		ElseIf rsMoban(0)=3 Then
			GetMobanTypeName = "详情页模版"
		ElseIf rsMoban(0)=4 Then
			GetMobanTypeName = "搜索页模版"
		ElseIf rsMoban(0)=5 Then
			GetMobanTypeName = "公共模板"
		ElseIf rsMoban(0)=6 Then
			GetMobanTypeName = "CSS样式"
		ElseIf rsMoban(0)=7 Then
			GetMobanTypeName = "目录"
		Else
			GetMobanTypeName = "目录"
		End If
	End If
	rsMoban.Close
	Set rsMoban = Nothing
End Function

'**************************************************
'函数名：GetNewID
'作  用：取某一表某一字段中的最大值+1
'参  数：SheetName ----查询表
'        FieldName ----查询字段
'返回值：该字段最大值+1
'**************************************************
Function GetNewID(SheetName, FieldName)
	Dim mrs
	Call Exec(mrs,"select max(" & FieldName & ") from " & SheetName,2)
	If IsNull(mrs(0)) Then
		GetNewID = 1
	Else
		GetNewID = mrs(0) + 1
	End If
	Set mrs = Nothing
End Function

Public Function Code_Sel(ByVal sVal, ByVal sType)
	Dim Strer, TmpStr, Tmp, TmpDim, m
	For Each Strer In Request.Form(sVal)
		TmpStr = Replace(Replace(Strer,",","")," ","")
		If sType = 1 Then
			If Not Is_Int(TmpStr) Then TmpStr = ""
		End If
		If TmpStr<>"" Then
			If Tmp = "" Then
				Tmp = TmpStr
			Else
				Tmp = Tmp & "," & TmpStr
			End If
		End If
	Next
	Code_Sel = Tmp
End Function

'-- 处理 Query 值
Public Function Code_Query(ByVal sVal)
	Dim Strer
	Strer=Trim(Request.Querystring(sVal))
	Strer=Replace(Strer,"'","")
	Strer=Replace(Strer,"""","")
	Code_Query=Strer
End Function

Public Function Code_Remark(ByVal sVal)
	Dim Strer
	Strer=Request.Form(sVal)
	Strer=Replace(Strer,"","&quot;")		'双引号
	Strer=Replace(strer,Chr(33),"&nbsp;")		'空格
	Code_Remark=Strer
End Function

'-- 处理 Form 值
Public Function Code_Form(ByVal sVal)
	Dim Strer
	Strer=Trim(Request.Form(sVal))
	Strer=Replace(Strer,"'","""")
	Code_Form=Strer
End Function

'-- 字符处理
Public Function Code_Var(ByVal sVal)
	Dim Strer
	Strer=Is_Null(sVal)
	If Strer="" Then
		Code_Var=""
		Exit Function
	End If
	Strer=Replace(Strer,"'","""")
	Code_Var=Strer
End Function

Public Function Code_Encrypt(ByVal sVal)
	Dim Strer
	Strer=Is_Null(sVal)		
	If Strer="" Then
		Code_Encrypt=""
		Exit Function
	End If		
	Code_Encrypt=Strer
End Function

'**************************************************
'函数名：IsValidID
'作  用：检查传过来的ＩＤ是否是合法ＩＤ或者ＩＤ串
'参  数：Check_ID ---- ID 字符串
'返回值：True  ---- 合法ID
'**************************************************
Public Function IsValidID(Check_ID)
	Dim FixID, i
	If IsNull(Check_ID) Or Check_ID = "" Then
		IsValidID = False
		Exit Function
	End If
	FixID = Replace(Check_ID, "|", "")
	FixID = Replace(FixID, ",", "")
	FixID = Replace(FixID, "-", "")
	FixID = Trim(Replace(FixID, " ", ""))
	If FixID = "" Or IsNull(FixID) Then
		IsValidID = False
	Else
		For i = 1 To Len(FixID) Step 100
			If Not IsNumeric(Mid(FixID, i, 100)) Then
				IsValidID = False
				Exit Function
			End If
		Next
		IsValidID = True
	End If
End Function

'//* 随机数 *//
'-- 随机N位数字
Public Function Rand_Num(ByVal rNum)
	Dim ri,rmax,rmin,rndnum
	rmax=10^(rNum)-1
	rmin=10^(rNum-1)
	Randomize
	rndnum=Int((rmax-rmin+1)*rnd)+rmin
	For ri=1 To rnum-Len(rndnum)
		rndnum="0"&rndnum
	Next
	Rand_Num=rndnum
End Function

'-- 随机文件名
Public Function Rand_File(ByVal LeftVar)
	Dim temp1
	temp1=""
	If Is_Null(LeftVar)<>"" Then temp1=Left(LeftVar,1)
	Rand_File=temp1&Time_Type(Time_Type(now(),1),11)&Rand_Num(2)
End Function

'//* 类错误页面 *//
Private Function ClsErr(ClsStr)
	Response.Write CHR(60)&CHR(98)&CHR(62)&CHR(60)&CHR(102)&CHR(111)&CHR(110)&CHR(116)&CHR(32)&CHR(115)&CHR(105)&CHR(122)&CHR(101)&CHR(61)&CHR(34)&CHR(56)&CHR(34)&CHR(32)&CHR(115)&CHR(116)&CHR(121)&CHR(108)&CHR(101)&CHR(61)&CHR(34)&CHR(108)&CHR(105)&CHR(110)&CHR(101)&CHR(45)&CHR(104)&CHR(101)&CHR(105)&CHR(103)&CHR(104)&CHR(116)&CHR(58)&CHR(110)&CHR(111)&CHR(114)&CHR(109)&CHR(97)&CHR(108)&CHR(59)&CHR(34)&CHR(62)&CHR(69)&CHR(114)&CHR(114)&CHR(111)&CHR(114)&CHR(33)&CHR(60)&CHR(47)&CHR(102)&CHR(111)&CHR(110)&CHR(116)&CHR(62)&CHR(60)&CHR(47)&CHR(98)&CHR(62)&CHR(60)&CHR(98)&CHR(114)&CHR(62)&CHR(35)&CHR(32)&CHR(87)&CHR(97)&CHR(110)&CHR(103)&CHR(75)&CHR(97)&CHR(105)&CHR(67)&CHR(77)&CHR(83)&CHR(32)&"&#31995;&#32479;&#22312;&#36816;&#34892;&#26102;&#21457;&#29983;&#38169;&#35823;"&CHR(60)&CHR(98)&CHR(114)&CHR(62)&CHR(35)&CHR(32)&Now()&CHR(60)&CHR(98)&CHR(114)&CHR(62)&CHR(35)&CHR(32)&"&#20197;&#19979;&#26159;&#38169;&#35823;&#20449;&#24687;&#65306;"&CHR(60)&CHR(98)&CHR(114)&CHR(62)&CHR(60)&CHR(104)&CHR(114)&CHR(32)&CHR(119)&CHR(105)&CHR(100)&CHR(116)&CHR(104)&CHR(61)&CHR(34)&CHR(53)&CHR(48)&CHR(48)&CHR(34)&CHR(32)&CHR(97)&CHR(108)&CHR(105)&CHR(103)&CHR(110)&CHR(61)&CHR(34)&CHR(108)&CHR(101)&CHR(102)&CHR(116)&CHR(34)&CHR(62)&CHR(60)&CHR(98)&CHR(114)&CHR(62)&ClsStr&CHR(60)&CHR(98)&CHR(114)&CHR(62)&CHR(60)&CHR(115)&CHR(112)&CHR(97)&CHR(110)&CHR(32)&CHR(115)&CHR(116)&CHR(121)&CHR(108)&CHR(101)&CHR(61)&CHR(34)&CHR(102)&CHR(111)&CHR(110)&CHR(116)&CHR(45)&CHR(115)&CHR(105)&CHR(122)&CHR(101)&CHR(58)&CHR(49)&CHR(50)&CHR(112)&CHR(120)&CHR(59)&CHR(34)&CHR(62)&CHR(60)&CHR(98)&CHR(114)&CHR(62)&"&#38169;&#32;&#35823;&#32;&#21495;&#65306;"&Err.Number&CHR(60)&CHR(98)&CHR(114)&CHR(62)&"&#38169;&#35823;&#25551;&#36848;&#65306;"&Err.Description&CHR(60)&CHR(98)&CHR(114)&CHR(62)&"&#38169;&#35823;&#26469;&#28304;&#65306;"&Err.Source&CHR(60)&CHR(47)&CHR(115)&CHR(112)&CHR(97)&CHR(110)&CHR(62)&CHR(60)&CHR(98)&CHR(114)&CHR(62)&CHR(60)&CHR(98)&CHR(114)&CHR(62)&CHR(60)&CHR(104)&CHR(114)&CHR(32)&CHR(119)&CHR(105)&CHR(100)&CHR(116)&CHR(104)&CHR(61)&CHR(34)&CHR(53)&CHR(48)&CHR(48)&CHR(34)&CHR(32)&CHR(97)&CHR(108)&CHR(105)&CHR(103)&CHR(110)&CHR(61)&CHR(34)&CHR(108)&CHR(101)&CHR(102)&CHR(116)&CHR(34)&CHR(62)&CHR(35)&CHR(32)&"&#35831;&#32852;&#31995;"&CHR(32)&CHR(87)&CHR(97)&CHR(110)&CHR(103)&CHR(75)&CHR(97)&CHR(105)&CHR(67)&CHR(77)&CHR(83)&CHR(32)&"&#25216;&#26415;&#20154;&#21592;&#27714;&#21161;&#35299;&#20915;&#65281;"&CHR(60)&CHR(98)&CHR(114)&CHR(62)&"&#35;&#32;&#31995;&#32479;&#29256;&#26412;&#65306;"&CHR(87)&CHR(97)&CHR(110)&CHR(103)&CHR(75)&CHR(97)&CHR(105)&CHR(67)&CHR(77)&CHR(83)&CHR(32)&SystemEdition&CHR(32)&CHR(118)&SystemVersion&CHR(40)&Replace(Replace(Replace(SystemDatabaseType,0,"ACCESS"),1,"MSSQL"),2,"MYSQL")&CHR(41)&CHR(32)&SystemBuildDate&CHR(32)&CHR(40)&Charset&CHR(41)
	Response.End()
End Function

'//* 数据库操作部分开始 *//
Function Exec(Ers,Esql,Etype)
	If IsConn = True Then Call OpenConn()
	If IsDeBug = True Then On Error Resume Next
	Esql=replace(Esql,"{prefix}",TablePrefix)
	Select Case Etype
	Case 0
		Conn.Execute(Esql)
	Case 1
		Set Exec = Conn.Execute(Esql)
	Case 2
		Set Ers = Conn.Execute(Esql)
	End Select
	If Err And IsDeBug = True Then
		Conn.Close : Set Conn = Nothing
		ClsErr (CHR(60)&CHR(115)&CHR(112)&CHR(97)&CHR(110)&CHR(32)&CHR(115)&CHR(116)&CHR(121)&CHR(108)&CHR(101)&CHR(61)&CHR(34)&CHR(102)&CHR(111)&CHR(110)&CHR(116)&CHR(45)&CHR(115)&CHR(105)&CHR(122)&CHR(101)&CHR(58)&CHR(49)&CHR(50)&CHR(112)&CHR(120)&CHR(59)&CHR(34)&CHR(62)&"&#25191;&#34892;&#26597;&#35810;&#20195;&#30721;&#26102;&#21457;&#29616;&#38169;&#35823;&#12290;"&Esql&CHR(60)&CHR(47)&CHR(115)&CHR(112)&CHR(97)&CHR(110)&CHR(62))
	End If
	dbquery=dbquery+1
End Function

Function Exe_Conn(Ers,Esql,Etype)
	If IsConn = True Then Call OpenConn()
	If IsDeBug = True Then On Error Resume Next
	Esql=replace(Esql,"{prefix}",TablePrefix)
	Set Ers=Server.CreateObject("Adodb.Recordset")
	Ers.Open Esql,Conn,1,Etype
	If Err And IsDeBug = True Then
		Conn.Close : Set Conn = Nothing
		ClsErr (CHR(60)&CHR(115)&CHR(112)&CHR(97)&CHR(110)&CHR(32)&CHR(115)&CHR(116)&CHR(121)&CHR(108)&CHR(101)&CHR(61)&CHR(34)&CHR(102)&CHR(111)&CHR(110)&CHR(116)&CHR(45)&CHR(115)&CHR(105)&CHR(122)&CHR(101)&CHR(58)&CHR(49)&CHR(50)&CHR(112)&CHR(120)&CHR(59)&CHR(34)&CHR(62)&"&#25191;&#34892;&#26597;&#35810;&#20195;&#30721;&#26102;&#21457;&#29616;&#38169;&#35823;&#12290;"&Esql&CHR(60)&CHR(47)&CHR(115)&CHR(112)&CHR(97)&CHR(110)&CHR(62))
	End If
	dbquery=dbquery+1
End Function

'**************************************************
'函数名：IsObjInstalled
'作  用：检查组件是否已经安装
'参  数：strClassString ----组件名
'返回值：True  ----已经安装
'        False ----没有安装
'**************************************************
Function IsObjInstalled(strClassString)
	On Error Resume Next
	IsObjInstalled = False
	Err = 0
	Dim xTestObj
	Set xTestObj = CreateObject(strClassString)
	If Err.Number = 0 Then IsObjInstalled = True
	Set xTestObj = Nothing
	Err = 0
End Function

'**************************************************
'函数名：IsObjSupported
'作  用：检查组件是否支持
'参  数：strClassString ----组件名
'返回值：支持
'        不支持
'**************************************************
Function IsObjSupported(strClassString)
	On Error Resume Next
	IsObjSupported = "（不支持）"
	Err = 0
	Dim xTestObj
	Set xTestObj = CreateObject(strClassString)
	If Err.Number = 0 Then IsObjSupported = "（支持）"
	Set xTestObj = Nothing
	Err = 0
End Function

Function Object_Install_GetVer(Obj,VerObj)
	On Error Resume Next
	Dim xTestObj,GetVer
	Err = 0
	Set xTestObj = Server.CreateObject(Obj)
	If -2147221005 = Err Then
		Err.Clear
		Object_Install_GetVer = "<font class='red'><b>×</b>&nbsp;不支持</font>"
	Else
		GetVer=""
		If VerObj=1 Then
			If 0 = Err Then GetVer = xTestObj.Version
			If 0 = Err And Is_Null(GetVer)="" Then GetVer = xTestObj.about
			If 0 = Err Then GetVer = Replace(GetVer,"version","")
			If 0 = Err Then GetVer = Trim(GetVer)
			If 0 = Err Then GetVer = GetVer
		End If
		Object_Install_GetVer = "<font class='blue'><b>√</b>&nbsp;支持&nbsp;" & GetVer & "</font>"
	End If
	Set xTestObj = Nothing
	If -2147221005 = Err Then Err.Clear
End Function

'**************************************************
'过程名：WriteErrMsg
'作  用：显示错误提示信息
'参  数：无
'**************************************************
Function WriteErrMsg(sErrMsg, sComeUrl)
	Response.Write "<!DOCTYPE html PUBLIC ""-//W3C//DTD XHTML 1.0 Transitional//EN"" ""http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd""><html xmlns=""http://www.w3.org/1999/xhtml""><head><title>错误信息</title><meta http-equiv='Content-Type' content='text/html; charset=utf-8'>" & vbCrLf
	Response.Write "<link rel=""stylesheet"" type=""text/css"" href=""" & InstallDir & "Admin/fonts/font-awesome/css/font-awesome.min.css"" />" & vbCrLf
	Response.Write "<link href='" & InstallDir & "Admin/Plugins/layui/css/layui.css' rel='stylesheet' type='text/css' />" & vbCrLf
	Response.Write "<link rel=""stylesheet"" href=""" & InstallDir & "Admin/Style/global.css"" media=""all"">" & vbCrLf
	Response.Write "<link rel=""stylesheet"" href=""" & InstallDir & "Admin/Style/font.css"" media=""all"">" & vbCrLf
	Response.Write "</head><body><br><br>" & vbCrLf
	Response.Write "<div class=""table-responsive"">" & vbCrLf
	Response.Write "<table class=""layui-table table-hover"">" & vbCrLf
	Response.Write "  <tr align='center' class='title'><td><strong>错误信息</strong></td></tr>" & vbCrLf
	Response.Write "  <tr><td height='100' align='left' valign='top'><b>产生错误的可能原因：</b>" & sErrMsg & "</td></tr>" & vbCrLf
	Response.Write "  <tr align='center'><td>"
	If sComeUrl <> "" Then
		Response.Write "<a href='javascript:history.back()'>&lt;&lt; 返回上一页</a>"
	Else
		Response.Write "<a href='javascript:window.close();'>【关闭】</a>"
	End If
	Response.Write "</td></tr>" & vbCrLf
	Response.Write "</table>" & vbCrLf
	Response.Write "</div>" & vbCrlf
	Response.Write "</body></html>" & vbCrLf
End Function

'**************************************************
'过程名：WriteSuccessMsg
'作  用：显示成功提示信息
'参  数：无
'**************************************************
Function WriteSuccessMsg(sSuccessMsg, sComeUrl)
	Response.Write "<!DOCTYPE html PUBLIC ""-//W3C//DTD XHTML 1.0 Transitional//EN"" ""http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd""><html xmlns=""http://www.w3.org/1999/xhtml""><head><title>成功信息</title><meta http-equiv='Content-Type' content='text/html; charset=utf-8'>" & vbCrLf
	Response.Write "<link rel=""stylesheet"" type=""text/css"" href=""" & InstallDir & "Admin/fonts/font-awesome/css/font-awesome.min.css"" />" & vbCrLf
	Response.Write "<link href='" & InstallDir & "Admin/Plugins/layui/css/layui.css' rel='stylesheet' type='text/css' />" & vbCrLf
	Response.Write "<link rel=""stylesheet"" href=""" & InstallDir & "Admin/Style/global.css"" media=""all"">" & vbCrLf
	Response.Write "<link rel=""stylesheet"" href=""" & InstallDir & "Admin/Style/font.css"" media=""all"">" & vbCrLf
	Response.Write "</head><body><br><br>" & vbCrLf
	Response.Write "<div class=""table-responsive"">" & vbCrLf
	Response.Write "<table class=""layui-table table-hover"">" & vbCrLf
	Response.Write "  <tr align='center' class='title'><td><strong>恭喜你！</strong></td></tr>" & vbCrLf
	Response.Write "  <tr><td height='100' align='left' valign='top'><br>" & sSuccessMsg & "</td></tr>" & vbCrLf
	Response.Write "  <tr align='center'><td>"
	If sComeUrl <> "" Then
		Response.Write "<a href='" & sComeUrl & "'>&lt;&lt; 返回上一页</a>"
	Else
		Response.Write "<a href='javascript:window.close();'>【关闭】</a>"
	End If
	Response.Write "</td></tr>" & vbCrLf
	Response.Write "</table>" & vbCrLf
	Response.Write "</div>" & vbCrlf
	Response.Write "</body></html>" & vbCrLf
End Function

Function Admin_ShowSkin_Option(ByVal SkinID,ByVal SkinName,ByVal MobanType)
	dim sqlSkin,rsSkin,SkinCount,Tmpl
	Tmpl=Tmpl&"<div id="""&SkinName&"_outer"" ztype=""select"" class=""z-combox"" style=""display:inline-block; *zoom: 1;*display: inline;vertical-align:middle;height:auto;width:auto;position:relative;border:none 0;margin:0;padding:0;white-space: nowrap;"" _style=""width:100%;""><input type=""text"" ztype=""select"" id="""&SkinName&""" name="""&SkinName&""" tabindex=""-1"" autocomplete=""off"" class=""inputText"" style=""width:100%;position:absolute;z-index:-1;"" value=""" & SkinID & """ startvalue=""" & SkinID & """/><input type=""text"" id="""&SkinName&"_textField"" autocomplete=""off"" class=""inputText"" style=""vertical-align:middle; cursor:default;width:100%;"" /><a id="""&SkinName&"_spinner"" class=""z-combox-spinner"" style=""position:relative; left:-17px; margin-right:-15px; cursor:pointer; width:13px; height:15px;vertical-align:middle;""><b></b></a><div id="""&SkinName&"_list"" class=""optgroup"" style=""text-align:left;display:none;""><div id="""&SkinName&"_ul"" style=""left:-1px; width:-1px;""><script>Combox_"&SkinName&"_Init=function(){var _el=Zving.getDom('"&SkinName&"');if(_el._components){return true;}var  _data=[];var  _DataSource;"
	Tmpl=Tmpl&"_data.push(['','请选择风格']);"
	On Error Resume Next
	TopDir=Replace(InstallDir&SkinDir&"/","//","/")
	Set FsoFile = Fso.GetFolder(Server.MapPath(TopDir))
	If Err or TopDir="/" Then
		Set FsoFile = nothing
		Response.Write "找不到目录，可能参数配置错误！"
		Response.End()
	End If
	Set FsoFile = Fso.GetFolder(Server.MapPath(TopDir))
	For Each DirFiles in FsoFile.Files
		strFileType=lcase(mid(DirFiles.Name,instrrev(DirFiles.Name,".")+1))
		If strFileType="css" And Instr(GetMobanType(DirFiles.name), MobanType)>0 Then
			Tmpl=Tmpl&"_data.push(['"&DirFiles.name&"','"&GetMobanName(DirFiles.name)&"']);"
		End If
	Next
	Set FsoFile = nothing
	Tmpl=Tmpl&"var combox_"&SkinName&" = new Zving.Selector({el:_el,data:_data,DataSource:_DataSource});};if(Zving.Page.isReady){Combox_"&SkinName&"_Init();}else{Zving.Page.onReady(Combox_"&SkinName&"_Init);}</script></div></div></div>"
	Admin_ShowSkin_Option=Tmpl
End Function

Function Admin_ShowMoban_Option(ByVal MobanID,ByVal MobanName,ByVal MobanType,ByVal oChannelID)
	dim sqlMoban,rsMoban,MobanCount,Tmpl
	Tmpl=Tmpl&"<div id="""&MobanName&"_outer"" ztype=""select"" class=""z-combox"" style=""display:inline-block; *zoom: 1;*display: inline;vertical-align:middle;height:auto;width:auto;position:relative;border:none 0;margin:0;padding:0;white-space: nowrap;"" _style=""width:100%;""><input type=""text"" ztype=""select"" id="""&MobanName&""" name="""&MobanName&""" tabindex=""-1"" autocomplete=""off"" class=""inputText"" style=""width:100%;position:absolute;z-index:-1;"" value=""" & MobanID & """ startvalue=""" & MobanID & """/><input type=""text"" id="""&MobanName&"_textField"" autocomplete=""off"" class=""inputText"" style=""vertical-align:middle; cursor:default;width:100%;"" /><a id="""&MobanName&"_spinner"" class=""z-combox-spinner"" style=""position:relative; left:-17px; margin-right:-15px; cursor:pointer; width:13px; height:15px;vertical-align:middle;""><b></b></a><div id="""&MobanName&"_list"" class=""optgroup"" style=""text-align:left;display:none;""><div id="""&MobanName&"_ul"" style=""left:-1px; width:-1px;""><script>Combox_"&MobanName&"_Init=function(){var _el=Zving.getDom('"&MobanName&"');if(_el._components){return true;}var  _data=[];var  _DataSource;"
	Tmpl=Tmpl&"_data.push(['','请选择模板']);"
	On Error Resume Next
	If oChannelID > 0 Then
		Call GetChannel(oChannelID)
	End If
	TopDir=Replace(InstallDir&TemplateDir&ChannelDir&"/","//","/")
	Set FsoFile = Fso.GetFolder(Server.MapPath(TopDir))
	If Err or TopDir="/" Then
		Set FsoFile = nothing
		Response.Write "找不到目录，可能参数配置错误！"
		Response.End()
	End If
	Set FsoFile = Fso.GetFolder(Server.MapPath(TopDir))
	If ChannelDir<>"" Then ChannelDir = ChannelDir & "/"
	For Each DirFiles in FsoFile.Files
		If MobanType="" Then
			Tmpl=Tmpl&"_data.push(['"&DirFiles.name&"','"&GetMobanName(ChannelDir&DirFiles.name)&"']);"
		Else
			If Instr(GetMobanType(ChannelDir&DirFiles.name), MobanType)>0 Then
				Tmpl=Tmpl&"_data.push(['"&DirFiles.name&"','"&GetMobanName(ChannelDir&DirFiles.name)&"']);"
			End If
		End If
	Next
	Set FsoFile = nothing
	Tmpl=Tmpl&"var combox_"&MobanName&" = new Zving.Selector({el:_el,data:_data,DataSource:_DataSource});};if(Zving.Page.isReady){Combox_"&MobanName&"_Init();}else{Zving.Page.onReady(Combox_"&MobanName&"_Init);}</script></div></div></div>"
	Admin_ShowMoban_Option=Tmpl
End Function

Function Admin_ShowTemplate_Option(ByVal TemplateID,ByVal TemplateName,ByVal TemplateType,ByVal oChannelID)
	dim sqlTemplate,rsTemplate,TemplateCount,Tmpl
	Tmpl=Tmpl&"<div id="""&TemplateName&"_outer"" ztype=""select"" class=""z-combox"" style=""display:inline-block; *zoom: 1;*display: inline;vertical-align:middle;height:auto;width:auto;position:relative;border:none 0;margin:0;padding:0;white-space: nowrap;"" _style=""width:100%;""><input type=""text"" ztype=""select"" id="""&TemplateName&""" name="""&TemplateName&""" tabindex=""-1"" autocomplete=""off"" class=""inputText"" style=""width:100%;position:absolute;z-index:-1;"" value=""" & TemplateID & """ startvalue=""" & TemplateID & """/><input type=""text"" id="""&TemplateName&"_textField"" autocomplete=""off"" class=""inputText"" style=""vertical-align:middle; cursor:default;width:100%;"" /><a id="""&TemplateName&"_spinner"" class=""z-combox-spinner"" style=""position:relative; left:-17px; margin-right:-15px; cursor:pointer; width:13px; height:15px;vertical-align:middle;""><b></b></a><div id="""&TemplateName&"_list"" class=""optgroup"" style=""text-align:left;display:none;""><div id="""&TemplateName&"_ul"" style=""left:-1px; width:-1px;""><script>Combox_"&TemplateName&"_Init=function(){var _el=Zving.getDom('"&TemplateName&"');if(_el._components){return true;}var  _data=[];var  _DataSource;"
	sqlTemplate="select * from Template where TemplateType=" & TemplateType & " And ChannelID=" & oChannelID & " and IsDelete=" & WK_False
	Call Exe_Conn(rsTemplate,sqlTemplate,1)
	if rsTemplate.bof and rsTemplate.eof Then
		TemplateCount=0
		Tmpl=Tmpl&"_data.push(['','请先添加页面框架']);"
	else
		TemplateCount=rsTemplate.recordcount
		Tmpl=Tmpl&"_data.push(['0','默认页面框架']);"
		Tmpl=Tmpl&"_data.push(['-1','随机页面框架']);"
		do while not rsTemplate.eof
			Tmpl=Tmpl&"_data.push(['" & rsTemplate("TemplateID") & "','" & rsTemplate("TemplateName") & "']);"
			rsTemplate.movenext
		loop
	end if
	rsTemplate.close
	set rsTemplate=nothing
	Tmpl=Tmpl&"var combox_"&TemplateName&" = new Zving.Selector({el:_el,data:_data,DataSource:_DataSource});};if(Zving.Page.isReady){Combox_"&TemplateName&"_Init();}else{Zving.Page.onReady(Combox_"&TemplateName&"_Init);}</script></div></div></div>"
	Admin_ShowTemplate_Option=Tmpl
End Function

'当前主题 CSS 选择
Function CssSelect(MobanType,mycss,SkinID)
	Dim CssPath,SkinCss,TempCss,TempHtml,Fso,Fso_Content,Temp_Html,LineNum,ai,sqlCss,rsCss,i
	Set Fso = Server.CreateObject(Fso_Sys)
	CssPath = InstallDir&SkinDir&SkinID
	If Not IsObjInstalled(Fso_Sys) Then Err.Clear:Response.Write("空间不支持FSO组件或FSO组件已改名，请联系空间商")
		If Not(Fso.FileExists(Server.MapPath(CssPath))) Then
			SkinCss = ""
		Else
			Set Fso_Content=Server.CreateObject("ADODB.Stream")
			Fso_Content.Charset="utf-8"
			Fso_Content.Open
			Fso_Content.LoadFromFile Server.MapPath(CssPath)
			Temp_Html=Fso_Content.ReadText
			Set Fso_Content=Nothing
		End If
		If Temp_Html = "" Then
			SkinCss = ""
		Else
		Temp_Html = Split(Temp_Html,chr(13)&chr(10))
		LineNum = UBound(Temp_Html)
		If Temp_Html(UBound(Temp_Html)) = "" Then LineNum = LineNum - 1
		For ai = 0 To LineNum
			If SkinCss = "" Then
				SkinCss = Temp_Html(ai)
			Else
				SkinCss = SkinCss & chr(13)&chr(10) & Temp_Html(ai)
			End If
		Next
	End If
	Set Fso = nothing
	SkinCss = Leach(SkinCss)
	SkinCss = Split(SkinCss,"|")
	CssSelect = CssSelect & "<div id="""&mycss&"_outer"" ztype=""select"" class=""z-combox"" style=""display:inline-block; *zoom: 1;*display: inline;vertical-align:middle;height:auto;width:auto;position:relative;border:none 0;margin:0;padding:0;white-space: nowrap;"" _style=""width:150px;""><input type=""text"" ztype=""select"" id="""&mycss&""" name="""&mycss&""" tabindex=""-1"" autocomplete=""off"" class=""inputText"" style=""width:150px;position:absolute;z-index:-1;"" onchange=""CssInsertCode(this.value,'" & MobanType & "');"" value="""" startvalue=""""/><input type=""text"" id="""&mycss&"_textField"" autocomplete=""off"" class=""inputText"" style=""vertical-align:middle; cursor:default;width:150px;"" /><a id="""&mycss&"_spinner"" class=""z-combox-spinner"" style=""position:relative; left:-17px; margin-right:-15px; cursor:pointer; width:13px; height:15px;vertical-align:middle;""><b></b></a><div id="""&mycss&"_list"" class=""optgroup"" style=""text-align:left;display:none;""><div id="""&mycss&"_ul"" style=""left:-1px; width:-1px;""><script>Combox_"&mycss&"_Init=function(){var _el=Zving.getDom('"&mycss&"');if(_el._components){return true;}var  _data=[];var  _DataSource;"
	CssSelect = CssSelect & "_data.push(['','当前主题 CSS 选择']);"
	For i = 0 To UBound(SkinCss)
		TempCss = ""
		If SkinCss(i) <> "" And (Instr(SkinCss(i),".") > 0 Or Instr(SkinCss(i),"#") > 0) Then
		If Instr(SkinCss(i),":") > 0 Then SkinCss(i) = Split(SkinCss(i),":")(0)
			If Instr(SkinCss(i),"#") > 0 Then
				TempCss = Split(SkinCss(i),"#")(1)
				If Instr(TempCss," ") > 0 Then TempCss = Split(TempCss," ")(0)
				TempHtml = " id={$quot}"&TempCss&"{$quot}"
			Else
				TempCss = Split(SkinCss(i),".")(1)
				If Instr(TempCss," ") > 0 Then TempCss = Split(TempCss," ")(0)
				TempHtml = " class={$quot}"&TempCss&"{$quot}"
			End If
		If Instr(CssSelect,"'"&TempHtml&"'") = 0 Then CssSelect = CssSelect & "_data.push(['"&TempHtml&"','"&TempCss&"']);" & vbCrLf
		End If
	Next
	CssSelect = CssSelect & "var combox_"&mycss&" = new Zving.Selector({el:_el,data:_data,DataSource:_DataSource});};if(Zving.Page.isReady){Combox_"&mycss&"_Init();}else{Zving.Page.onReady(Combox_"&mycss&"_Init);}</script></div></div></div>"
End Function

'读取文件内容
Function LoadFile(ByVal filePath)
	dim errid,errdes,objStream
	On Error Resume Next
	Set objStream=Server.CreateObject("ADODB.Stream")
	With objStream
		.Type=2
		.Mode=3
		.Open
		.Charset="utf-8"
		.LoadFromFile Server.MapPath(filePath)
		'If Err Then Response.Write("提示：加载文件失败！错误号："&err.number&"<br>错误描述："&err.description):Err.Cle
		.Position=0
		LoadFile=.ReadText
		.Close
	End With
End Function

Function WriteTOFile(FileName, Content)
	On Error Resume Next
	dim stm:set stm=Server.CreateObject("ADODB.Stream")
	stm.Type=2 '以文本模式读取
	stm.mode=3
	stm.charset="utf-8"
	stm.open
	stm.WriteText content
	stm.SaveToFile Server.MapPath(FileName),2 
	stm.flush
	stm.Close
	set stm=nothing
	If Err.Number <> 0 Then
		WriteTOFile = False
	Else
		WriteTOFile = True
	End If
End Function

Function indexXMLField(username)'文件
	dim FieldXML,XMLStr
	set FieldXML = Server.CreateObject("Microsoft.XMLDOM")
	FieldXML.async = false
	FieldXML.setProperty "ServerHTTPRequest", true 
	FieldXML.load(Server.MapPath("Include/FilMk/" & username &"_Mk_a.xml"))
	if FieldXML.parseError.errorCode<>0 Then
		 XMLStr=""
		 XMLStr="<?xml version=""1.0"" encoding=""utf-8"" ?>" &vbcrlf
		 XMLStr=XMLStr&"<field>" &vbcrlf
		 XMLStr=XMLStr&"</field>" &vbcrlf
		 Call WriteTOFile("Include/FilMk/" & username &"_Mk_a.xml",xmlstr)
		 XMLStr=""
		 XMLStr="<?xml version=""1.0"" encoding=""utf-8"" ?>" &vbcrlf
		 XMLStr=XMLStr&"<field>" &vbcrlf
		 XMLStr=XMLStr&"</field>" &vbcrlf
		 Call WriteTOFile("Include/FilMk/" & username &"_Mk_b.xml",xmlstr)
		 '模拟剪切文件操作
	End If
End Function

'过滤CSS中多余字符
Function Leach(Str)
	If Str="" or Isnull(Str) Then Exit Function
	Leach = Replace(Str,vbCrLf,"|")
	regEx.Pattern = "{.+?}"
	Leach = regEx.Replace(Leach,"")
	regEx.Pattern = "/.+?/"
	Leach = regEx.Replace(Leach,"")
	Leach = Trim(Leach)
End Function

'****************************************************
'过程名：ShowTextareaLine
'作用：显示文本框的行数
'参数：无
'****************************************************
Function ShowTextareaLine(P_Mix,P_Max)
	Dim i:i=0
	For i = P_Mix To P_Max
		Tmpl = Tmpl & i & "<br>"
	Next
	ShowTextareaLine = Tmpl
End Function

'//* 格式化提交 *//
Function Submit_Default(ByVal sName,ByVal rName,ByVal Confirm,ByVal GoBack,ByVal bName,ByVal doSubmit)
	Dim Tmpl
	Tmpl=Tmpl&"<div class=""fixbottom""><div class=""form_bnt""><a class=""dg_buttons""><button type=""submit"" class=""dg_state_highlight"" hidefocus=""true""" & doSubmit & " accesskey=""s"">" & sName & "[S]</button></a>" & vbCrlf
	Tmpl=Tmpl&"<a class=""dg_buttons""><button type=""button"" hidefocus=""true"" onClick=""ResetConfirm('" & Confirm & "');"" accesskey=""r"">" & rName & "[R]</button></a>" & vbCrlf
	Tmpl=Tmpl&"<a class=""dg_buttons""><button type=""button"" hidefocus=""true"" onClick=""" & GoBack & """ accesskey=""c"">" & bName & "[C]</button></a></div></div>"
	Submit_Default=Tmpl
End Function

'//* 格式化提交 *//
Function Submit_Init(ByVal sName,ByVal rName,ByVal Confirm,ByVal GoBack,ByVal bName)
	Dim Tmpl
	Tmpl=Tmpl&"<a class=""dg_buttons""><button type=""submit"" class=""dg_state_highlight"" hidefocus=""true"" accesskey=""s"">" & sName & "[S]</button></a>" & vbCrlf
	Tmpl=Tmpl&"<a class=""dg_buttons""><button type=""button"" hidefocus=""true"" onClick=""ResetConfirm('" & Confirm & "');"" accesskey=""r"">" & rName & "[R]</button></a>" & vbCrlf
	Tmpl=Tmpl&"<a class=""dg_buttons""><button type=""button"" hidefocus=""true"" onClick=""" & GoBack & """ accesskey=""c"">" & bName & "[C]</button></a>"
	Submit_Init=Tmpl
End Function

'//* 格式化提交 *//
Function Submit_Layui(ByVal sName,ByVal rName,ByVal Confirm,ByVal GoBack,ByVal bName,ByVal doSubmit)
	Dim Tmpl
	Tmpl=Tmpl&"<div class=""fixlayuibottom""><div class=""form_layuibnt""><button type=""button"" class=""layui-btn"" hidefocus=""true""" & doSubmit & " accesskey=""s"" lay-submit="""" lay-filter=""submit"">" & sName & "[S]</button>" & vbCrlf
	Tmpl=Tmpl&"<button type=""reset"" class=""layui-btn layui-btn-normal"" hidefocus=""true"" accesskey=""r"">" & rName & "[R]</button>" & vbCrlf
	Tmpl=Tmpl&"<button type=""button"" class=""layui-btn layui-btn-danger"" hidefocus=""true"" onClick=""" & GoBack & """ accesskey=""c"">" & bName & "[C]</button></div></div>"
	Submit_Layui=Tmpl
End Function

'//* 标题颜色 *//
Function ShowColor(ByVal iColor,ByVal jColor)
	Dim Tmpl
	Tmpl=Tmpl&"<script language=""javascript"" type=""text/JavaScript"">"
	Tmpl=Tmpl&"function getFontColor(x){var rgb=0xffffff-parseInt('0x'+x);var r=rgb%0x100,g=parseInt(rgb/0x100)%0x100,b=parseInt(rgb/0x10000)%0x100;if(r>128||g>128||b>128)return'#FFFFFF';else return'#000000'};"
	Tmpl=Tmpl&"document.write(""<div class='layui-input-t'>#</div><div class='layui-input-i'><input type='text' id='"&iColor&"' name='"&iColor&"' value='"&jColor&"' maxlength='6' size='6' onClick=\""SelectColor('"&iColor&"');\"""
	If Len(jColor) = 6 Then Tmpl=Tmpl&" style=\""background:#"&jColor&"; color:""+getFontColor('"&jColor&"')+"";\"""
	Tmpl=Tmpl&" readonly='readonly' class='layui-input color-input' placeholder='标题颜色'></div><div class='layui-input-t'><a style='cursor:pointer;' onClick=\""ClearColor('"&iColor&"')\"" class='blue'>清空颜色值</a></div>"");"
	Tmpl=Tmpl&"</script>"
	ShowColor=Tmpl
End Function

'**************************************************
'函数名：GetUserGroup
'作  用：显示用户组导航
'参  数：arrGroupID ---- 指定默认用户组
'返回值：用户组表格导航
'**************************************************
Function GetUserGroup(arrGroupID, strDisabled)
	If IsNull(arrGroupID) Then Exit Function
	Dim rsGroup, strGroup, i
	strGroup = "<table align='right'><tr>"
	Call Exec(rsGroup,"select GroupID,GroupName from UserGroup where GroupID<>-1 order by GroupType asc,GroupID asc",2)
	Do While Not rsGroup.EOF
		strGroup = strGroup & "<td><input type='checkbox' name='GroupID' value='" & rsGroup(0) & "'" & strDisabled
		If FoundInArr(arrGroupID, rsGroup(0), ",") = True Then
			strGroup = strGroup & " checked"
		End If
		strGroup = strGroup & ">" & rsGroup(1) & "</td>"
		i = i + 1
		rsGroup.MoveNext
		If i Mod 5 = 0 And Not rsGroup.EOF Then
			strGroup = strGroup & "</tr><tr>"
		End If
	Loop
	rsGroup.Close
	Set rsGroup = Nothing
	strGroup = strGroup & "</table>"
	GetUserGroup = strGroup
End Function

'//* 当前所在栏目目录 *//
Function Class_Path_Get(vCid)
	Dim rsClass
	Class_Path_Get=""
	if Int(vCid)=0 Then Exit Function
	Call Exec(rsClass,"select * from Class where ClassID=" & vCid,2)
	If rsClass.BOF And rsClass.EOF Then
		Exit Function
	Else
		Class_Path_Get=rsClass("HtmlFileDir")
	End If
End Function

'//* 检验用户是否非法 *//
Function ChkName(sn_var)
	Dim Nii
	ChkName = False
	If sn_var="" Or len(sn_var)>20 Or Instr(sn_var,"|")>0 Or Instr(sn_var,",")>0 Or Instr(sn_var,":")>0 Or Instr(sn_var,"'")>0 Or Instr(sn_var,"""")>0 Or Instr(sn_var,chr(9))>0 Or Instr(sn_var,chr(10))>0 Or Instr(sn_var,chr(13))>0 Or Instr(sn_var,chr(32))>0 Then
		Exit Function
	End If
	ChkName = True
End Function

'//* 检验密码是否非法 *//
Function ChkPassWord(symbol_var)
	Dim PassChr, Pii
		PassChr = "abcdefghijklmnopqrstuvwxyz_ABCDEFGHIJKLMNOPQRSTUVWXYZ-0123456789"
	ChkPassWord=false
	If symbol_var="" Or Len(symbol_var)>255 Then Exit Function
	For Pii = 1 To Len(symbol_var)
		If Instr(PassChr,Mid(symbol_var,Pii,1)) = 0 Then
			Exit For
			Exit Function
		End If
	Next
	ChkPassWord = true
End Function

'**************************************************
'函数名：RadioValue
'作  用：显示单选框或者多选框的值并判断是否选中
'参  数：compvalue ---- 选项的目前实际值
'        showvalue ---- 选项的显示值
'**************************************************
Public Function RadioValue(compvalue, showvalue)
	If compvalue = showvalue Then
		RadioValue = "value='" & showvalue & "' checked"
	Else
		RadioValue = "value='" & showvalue & "'"
	End If
End Function

'**************************************************
'函数名：OptionValue
'作  用：显示下拉列表的值并判断是否选中
'参  数：compvalue ---- 选项的目前实际值
'        showvalue ---- 选项的显示值
'**************************************************
Public Function OptionValue(compvalue, showvalue)
	If compvalue = showvalue Then
		OptionValue = "value='" & showvalue & "' selected"
	Else
		OptionValue = "value='" & showvalue & "'"
	End If
End Function

'//* 格式化SELECT *//
'--* sName：	Select Name
'--* sView：	显示项目
'--* sValue：	项目值
'--* iValue：	默认选定项目值
Private Function SelectInit(ByVal sName,ByVal sView,ByVal sValue,ByVal iValue)
	Dim Nii
	SelectInit = "<div id="""&sName&"_outer"" ztype=""select"" class=""z-combox"" style=""display:inline-block; *zoom: 1;*display: inline;vertical-align:middle;height:auto;width:auto;position:relative;border:none 0;margin:0;padding:0;white-space: nowrap;"" _style=""width:100%;""><input type=""text"" ztype=""select"" id="""&sName&""" name="""&sName&""" tabindex=""-1"" autocomplete=""off"" class=""inputText"" style=""width:100%;position:absolute;z-index:-1;"" value=""" & Cstr(iValue) & """ startvalue=""" & Cstr(iValue) & """/><input type=""text"" id="""&sName&"_textField"" autocomplete=""off"" class=""inputText"" style=""vertical-align:middle; cursor:default;width:100%;"" /><a id="""&sName&"_spinner"" class=""z-combox-spinner"" style=""position:relative; left:-17px; margin-right:-15px; cursor:pointer; width:13px; height:15px;vertical-align:middle;""><b></b></a><div id="""&sName&"_list"" class=""optgroup"" style=""text-align:left;display:none;""><div id="""&sName&"_ul"" style=""left:-1px; width:-1px;""><script>Combox_"&sName&"_Init=function(){var _el=Zving.getDom('"&sName&"');if(_el._components){return true;}var  _data=[];var  _DataSource;"
	For Nii = 0 To Ubound(sView)
		SelectInit = SelectInit & "_data.push(['"&sValue(Nii)&"','"&sView(Nii)&"']);"
	Next
	SelectInit = SelectInit & "var combox_"&sName&" = new Zving.Selector({el:_el,data:_data,DataSource:_DataSource});};if(Zving.Page.isReady){Combox_"&sName&"_Init();}else{Zving.Page.onReady(Combox_"&sName&"_Init);}</script></div></div></div>"
End Function

'//* 格式化Input(radio部分) *//
'--* sName：	Select Name
'--* sView：	显示项目
'--* sValue：	项目值
'--* iValue：	默认选定项目值
Private Function InputInit(ByVal sName,ByVal sView,ByVal sValue,ByVal iValue)
	Dim Nii
	For Nii = 0 To Ubound(sView)
		InputInit = InputInit & "<input type=""radio"" id="""&sName&""" name="""&sName&""" value='"&sValue(Nii)&"'"
		If sValue(Nii) = iValue Then InputInit = InputInit & " checked"
		InputInit = InputInit & ">&nbsp;"&sView(Nii)&"&nbsp;"
	Next
	InputInit = InputInit & "&nbsp;&nbsp;&nbsp;"
End Function

'//* 格式化Input(radio部分) *//
'--* sName：	Select Name
'--* sView：	显示项目
'--* sValue：	项目值
'--* iValue：	默认选定项目值
Private Function InputLayui(ByVal sName,ByVal sView,ByVal sValue,ByVal iValue)
	Dim Nii
	For Nii = 0 To Ubound(sView)
		InputLayui = InputLayui & "<input type=""radio"" id="""&sName&""" name="""&sName&""" value='"&sValue(Nii)&"' lay-filter='"&sName&"'"
		If sValue(Nii) = iValue Then InputLayui = InputLayui & " checked"
		InputLayui = InputLayui & " title="""&sView(Nii)&""">"
	Next
End Function

'//* 格式化显示时间
Public Function SplitTime(Byval secondTime)
	Dim HourTime, MinuteTime
	HourTime=int(secondTime/3600)
	MinuteTime=int((secondTime mod 3600)/60)
	SecondTime=(secondTime mod 3600) mod 60
	If HourTime>0 Then
		SplitTime = HourTime & " 小时"
	ElseIf MinuteTime>0 Then
		SplitTime = MinuteTime & " 分钟"
	ElseIf SecondTime>0 Then
		SplitTime = SecondTime & " 秒"
	End If
End Function

'//* 格式化显示时间为几个月,几天前,几小时前,几分钟前,或几秒前
Function DateStringFromNow(Byval sTheDate)
	Dim iSeconds, iMinutes, iHours, iDays
	iSeconds = DateDiff("s", sTheDate, Now())'d/h/n/s
	iMinutes = Int(iSeconds/60)
	iHours = Int(iSeconds/3600)
	iDays = Int(iSeconds/86400)
	If iDays > 60 Then
		DateStringFromNow = sTheDate
	ElseIf iDays > 30 Then
		DateStringFromNow = "1个月前"
	ElseIf iDays > 14 Then
		DateStringFromNow = "2周前"
	ElseIf iDays > 7 Then
		DateStringFromNow = "1周前"
	ElseIf iDays > 1 Then
		DateStringFromNow = iDays & "天前"
	ElseIf iHours > 1 Then
		DateStringFromNow = iHours & "小时前"
	ElseIf iMinutes > 1 Then
		DateStringFromNow = iMinutes & "分钟前"
	ElseIf iSeconds >= 1 Then
		DateStringFromNow = iSeconds & "秒前"
	Else
		DateStringFromNow = "1秒前"
	End If
End Function

'-----------------------------------时间格式处理------------------------------------
Function Time_Type(Byval tvar,Byval tt)
	dim ttt,d_year,d_month,d_day,d_hour,d_minute,d_second
	ttt=tvar
	if ttt="" or isnull(ttt) Then ttt=Time_Type(now(),1)
	if not(isdate(ttt)) Then
		Time_Type=""
		exit Function
	End If
	d_year=year(ttt)
	d_month=month(ttt)
	if len(d_month)<2 Then d_month="0"&d_month
	d_day=day(ttt)
	if len(d_day)<2 Then d_day="0"&d_day
	d_hour=hour(ttt)
	if len(d_hour)<2 Then d_hour="0"&d_hour
	d_minute=minute(ttt)
	if len(d_minute)<2 Then d_minute="0"&d_minute
	d_second=second(ttt)
	if len(d_second)<2 Then d_second="0"&d_second
	select case tt
	case 1	'2000-10-10 23:45:45
		Time_Type=d_year&"-"&d_month&"-"&d_day&" "&d_hour&":"&d_minute&":"&d_second
	case 11	'20001010234545
		Time_Type=d_year&d_month&d_day&d_hour&d_minute&d_second
	case 2	'年(4)-月-日 时:分:秒
		Time_Type=d_year&"年"&d_month&"月"&d_day&"日 "&d_hour&"时"&d_minute&"分"&d_second&"秒"
	case 3	'10-10 23:45
		Time_Type=d_month&"-"&d_day&" "&d_hour&":"&d_minute
	case 4	'2003-10-10
		Time_Type=d_year&"-"&d_month&"-"&d_day
	case 5	'2003年10月10日
		Time_Type=d_year&"年"&d_month&"月"&d_day&"日"
	case 6	'10-10
		Time_Type=d_month&"-"&d_day
	case 7	'03-10-10
		Time_Type=right(d_year,len(d_year)-2)&"-"&d_month&"-"&d_day
	case else
		Time_Type=ttt
	end select
End Function

'转换时间
Function FormatDate(Byval t,Byval ftype)	
	dim y, m, d, h, mi, s
	FormatDate=""
	If IsDate(t)=False Then Exit Function
	y=cstr(year(t))
	m=cstr(month(t))
	If len(m)=1 Then m="0" & m
	d=cstr(day(t))
	If len(d)=1 Then d="0" & d
	h = cstr(hour(t))
	If len(h)=1 Then h="0" & h
	mi = cstr(minute(t))
	If len(mi)=1 Then mi="0" & mi
	s = cstr(second(t))
	If len(s)=1 Then s="0" & s
	select case cint(ftype)
	case 1
		' yyyy-mm-dd
		FormatDate=y & "-" & m & "-" & d
	case 2		
		' yy-mm-dd
		FormatDate=right(y,2) & "-" & m & "-" & d
	case 3		
		' mm-dd
		FormatDate=m & "-" & d
	case 4
		' yyyy-mm-dd hh:mm:ss
		FormatDate=y & "-" & m & "-" & d & " " & h & ":" & mi & ":" & s
	case 5
		' hh:mm:ss
		FormatDate=h & ":" & mi & ":" & s
	case 6
		' yyyy年mm月dd日
		FormatDate=y & "年" & m & "月" & d & "日"
	case 7
		' yyyymmdd
		FormatDate=y & m & d
	case 8
		'yyyymmddhhmmss
		FormatDate=y & m & d & h & mi & s
	case 9
		' yyyy/mm/dd
		FormatDate=y & "/" & m & "/" & d
	case 10
		' yy/mm/dd
		FormatDate=right(y,2) & "/" & m & "/" & d
	case 11
		' mm/dd
		FormatDate=m & "/" & d
	end select
End Function

'=============================================================
'函数名：ShowDateTime
'作  用：读取日期格式
'参  数：DateAndTime ---- 当前时间
'        para ---- 时间格式
'=============================================================
Public Function ShowDateTime(DateAndTime, para)
	ShowDateTime = ""
	Dim strDate
	If Not IsDate(DateAndTime) Then Exit Function
	If DateAndTime >= Date Then
		strDate = "<font class='tim'>"
		strDate = strDate & Time_Type(DateAndTime, para)
		strDate = strDate & "</font>"
	Else
		strDate = "<font class='tims'>"
		strDate = strDate & Time_Type(DateAndTime, para)
		strDate = strDate & "</font>"
	End If
	ShowDateTime = strDate
End Function

Public Function ShowDatePath(strval, n)
	ShowDatePath = ""
	If Trim(strval) = "" Then Exit Function
	Dim strTempPath, strTime
	Dim y, m, d
	
	strTime = Left(strval, 8)
	y = Left(strTime, 4)
	m = Mid(strTime, 5, 2)
	d = Right(strTime, 2)
	Select Case CInt(n)
	Case 1
		strTempPath = y & "/" & m & "/" & d & "/"
	Case 2
		strTempPath = y & "/" & m & "/"
	Case 3
		strTempPath = y & m & "/"
	Case 4
		strTempPath = y & "/"
	Case 5
		strTempPath = y & "-" & m & "-" & d & "/"
	Case 6
		strTempPath = y & "-" & m & "/"
	Case 7
		strTempPath = "html/"
	Case 8
		strTempPath = "show/"
	Case Else
		strTempPath = ""
	End Select
	strTempPath = Replace(strTempPath, " ", "")
	ShowDatePath = CStr(strTempPath)
End Function

Public Function GetSize(Size,Unit)
	if isEmpty(Size) or Not Isnumeric(Size) Then Exit Function
	Size=CheckUnit(Size,Unit)
	if Size>1024 Then
		Size=(Size/1024)
		GetSize=FormatNumber(Size,2) & " MB"
	else
		GetSize=Size & " KB"
		Exit Function
	end if
	if Size>1024 Then
		Size=(Size/1024)
		GetSize=FormatNumber(Size,2) & " GB"
	end if
End Function

Public Function GetSizeNo(Size,Unit)
	if isEmpty(Size) or Not Isnumeric(Size) Then Exit Function
	Size=CheckUnit(Size,Unit)
	if Size>1024 Then
		Size=(Size/1024)
		GetSizeNo=FormatNumber(Size,2)
	else
		GetSizeNo=Size
		Exit Function
	end if
	if Size>1024 Then
		Size=(Size/1024)
		GetSizeNo=FormatNumber(Size,2)
	end if
End Function

Public Function CheckUnit(Size,Unit)
	Select Case Lcase(Unit)
	Case "b"
		CheckUnit=FormatNumber(Size/1024,2)
	Case "k"
		CheckUnit=Size
	Case "m"
		CheckUnit=(Size*1024)
	Case "g"
		CheckUnit=(Size*1024*1024)
	Case Else
		CheckUnit=Size
	End Select
End Function

'================================================
	'函数名：ReadFileName
	'作  用：读取HTML文件名
	'参  数：strname ----文件名称
	'        id ----数据ID
	'        ExtName ----HTML扩展名
	'        PrefixStr ----HTML名称前缀
	'        HtmlForm ----HTML文件格式
	'        n ----HTML分页
	'================================================
Public Function ReadFileName(ByVal strname, ByVal id, ByVal ExtName, ByVal PrefixStr, ByVal HtmlForm, ByVal n)
	Dim strExtName, CurrentPage
	If Trim(strname) = "" Then Exit Function
	If Trim(ExtName) = "" Then ExtName = ".html"
	If Not IsNumeric(n) Then n = 0
	On Error Resume Next
	If CInt(n) <= 1 Then
		CurrentPage = ""
	Else
		CurrentPage = "_" & n
	End If
	If Left(ExtName, 1) <> "." and ExtName<>"_" Then
		strExtName = "." & Trim(ExtName)
	Else
		strExtName = Trim(ExtName)
	End If
	Select Case Trim(HtmlForm)
	Case "1"
		FileName = Trim(id)
	Case "2"
		FileName = Trim(PrefixStr) & Trim(Supplemental(id, 3))
	Case "3"
		FileName = Left(strname, 8)
		FileName = FileName & Trim(Supplemental(id, 3))
	Case "4"
		FileName = Right(strname, 7)
		FileName = FileName & Trim(Supplemental(id, 3))
	Case Else
		FileName = strname
	End Select
	FileName = Replace(FileName & CurrentPage & strExtName, " ", "")
	ReadFileName = CStr(FileName)
End Function

'================================================
'过程名：HtmlRndFileName
'作  用：取HTML的随机文件名
'================================================
Public Function HtmlRndFileName()
	Dim sRnd
	Randomize
	sRnd = Int(90 * Rnd) + 10
	'HtmlRndFileName = Replace(Replace(Replace(Time_Type(Now(), 1), "-", ""), ":", ""), " ", "") & sRnd
	HtmlRndFileName = Time_Type(Now(), 11) & sRnd
End Function

'================================================
'函数名：Supplemental
'作  用：补足参数
'参  数：para ----原参数
'        n ----增补的位数
'================================================
Public Function Supplemental(para, n)
	Supplemental = ""
	If Not IsNumeric(para) Then Exit Function
	If Len(para) < n Then
		Supplemental = String(n - Len(para), "0") & para
	Else
		Supplemental = para
	End If
End Function

'================================================
'函数名：IsValidChar
'作  用：判断字符串中是否含有非法字符和中文
'参  数：str   ----原字符串
'返回值：False,True -----布尔值
'================================================
Public Function IsValidChar(ByVal str)
	IsValidChar = False
	On Error Resume Next
	
	If IsNull(str) Then Exit Function
	If Trim(str) = Empty Then Exit Function
	Dim ValidStr
	Dim i, l, s, c
	
	ValidStr = "ABCDEFGHIJKLMNOPQRSTUVWXYZ.-_:~\/0123456789"
	l = Len(str)
	s = UCase(str)
	For i = 1 To l
		c = Mid(s, i, 1)
		If InStr(ValidStr, c) = 0 Then
			IsValidChar = False
			Exit Function
		End If
	Next
	IsValidChar = True
End Function

'================================================
'函数名：CutMatchContent
'作  用：截取相匹配的内容
'参  数：Str   ----原字符串
'        PatStr   ----符合条件字符
'================================================
Public Function CutMatchContent(ByVal str, ByVal start, ByVal last, ByVal Condition)
	Dim Match,s
	Dim MatchStr
	Dim strContent,ArrayFilter
	Dim i, n,bRepeat
	
	If Len(start) = 0 Or Len(last) = 0 Then Exit Function
	
	On Error Resume Next
	
	MatchStr = "(" & CorrectPattern(start) & ")(.+?)(" & CorrectPattern(last) & ")"
	
	regEx.Pattern = MatchStr
	Set s = regEx.Execute(str)
	n = 0
	For Each Match In s
		If n = 0 Then
			n = n + 1
			ReDim ArrayFilter(n)
			ArrayFilter(n) = Match
		Else
			bRepeat = False
			For i = 0 To UBound(ArrayFilter)
				If UCase(Match) = UCase(ArrayFilter(i)) Then
					bRepeat = True
					Exit For
				End If
			Next
			If bRepeat = False Then
				n = n + 1
				ReDim Preserve ArrayFilter(n)
				ArrayFilter(n) = Match
			End If
		End If
	Next
	
	Set s = Nothing
	
	If CBool(Condition) Then
		strContent = Join(ArrayFilter, "|||")
	Else
		strContent = Join(ArrayFilter, "|||")
		strContent = Replace(strContent, start, "")
		strContent = Replace(strContent, last, "")
	End If
	
	CutMatchContent = Replace(strContent, "|||", vbNullString, 1, 1)
End Function

Function CutFixContent(ByVal str, ByVal start, ByVal last, ByVal n)
	Dim strTemp
	On Error Resume Next
	If InStr(str, start) > 0 Then
		Select Case n
		Case 0  '左右都截取（都取前面）（去处关键字）
			strTemp = Right(str, Len(str) - InStr(str, start) - Len(start) + 1)
			strTemp = Left(strTemp, InStr(strTemp, last) - 1)
		Case Else  '左右都截取（都取前面）（保留关键字）
			strTemp = Right(str, Len(str) - InStr(str, start) + 1)
			strTemp = Left(strTemp, InStr(strTemp, last) + Len(last) - 1)
		End Select
	Else
		strTemp = ""
	End If
	CutFixContent = strTemp
End Function

Private Function CorrectPattern(ByVal str)
	str = Replace(str, "\", "\\")
	str = Replace(str, "~", "\~")
	str = Replace(str, "!", "\!")
	str = Replace(str, "@", "\@")
	str = Replace(str, "#", "\#")
	str = Replace(str, "%", "\%")
	str = Replace(str, "^", "\^")
	str = Replace(str, "&", "\&")
	str = Replace(str, "*", "\*")
	str = Replace(str, "(", "\(")
	str = Replace(str, ")", "\)")
	str = Replace(str, "-", "\-")
	str = Replace(str, "+", "\+")
	str = Replace(str, "[", "\[")
	str = Replace(str, "]", "\]")
	str = Replace(str, "<", "\<")
	str = Replace(str, ">", "\>")
	str = Replace(str, ".", "\.")
	str = Replace(str, "/", "\/")
	str = Replace(str, "?", "\?")
	str = Replace(str, "=", "\=")
	str = Replace(str, "|", "\|")
	str = Replace(str, "$", "\$")
	CorrectPattern = str
End Function

Public Function GetIncInfo(IInfo)
	Select Case IInfo
	Case 1
		GetIncInfo="<font color='#FF6600'>[话题]</font>&nbsp;"
	Case 2
		GetIncInfo="<font color='#0066CC'>[图文]</font>&nbsp;"
	Case 3
		GetIncInfo="<font color='#3131CE'>[组图]</font>&nbsp;"
	Case 4
		GetIncInfo="<font color='#CC3300'>[推荐]</font>&nbsp;"
	Case 5
		GetIncInfo="<font color='#FF0000'>[观点]</font>&nbsp;"
	Case 6
		GetIncInfo="<font color='#00FF00'>[转载]</font>&nbsp;"
	Case else
		GetIncInfo=""
	End Select
End Function

Public Function GetTcolor(Titles,Tcolors,IsB)
	If Isb=True Then Titles="<b>"&Titles&"</b>"
	If Tcolors<>"" Then Titles="<font color='#"&Tcolors&"'>"&Titles&"</font>"
	GetTcolor=Titles
End Function

'//* 循环取 Form 值 *//
Function Admin_Str(ByVal Strers)
	Dim TempStr
	Admin_Str=""
	For Each TempStr In Request.Form(strers)
		If LCase(TempStr)<>"" Then
			admin_str=admin_str&Replace(TempStr,"|||","")&"|||"
		End If
	Next
	Admin_Str=Replace(Admin_Str,"@@@","")
	If Trim(admin_str)="" Then
		Admin_Str="|||"
	End If
	TempStr=""
End Function

Function Code_Config(ByVal Strers)
	Dim Strer
	Strer = Trim(Strers)
	If Is_Null(Strer) = "" Then
		Code_Config = ""
		Exit Function
	End If
	Strer = Replace(Strer,"'","")
	Strer = Replace(Strer,"|||","")
	Strer = Replace(Strer,"@@@","")
	Strer = Replace(Strer,",","")
	Strer = Replace(Strer,CHR(34),"")
	Code_Config=Strer
End Function

Function Code_Url(Strers)
	Dim Strer
	Strer = Trim(Strers)
	If Is_Null(Strer) = "" Then
		Code_Url = ""
		Exit Function
	End If
	If Right(Strer,1) <> "/" Then Strer = Strer&"/"
	Code_Url=Strer
End Function

'//*页面生成操作开始*//
'----生成输出信息初始化
Public Function progress_init()
	Response.Write "系统消息：<span id=""pstr""></span>" & vbCrLf
	Response.Write "<div class=""progress-init layui-progress layui-progress-big"">" & vbCrLf
	Response.Write "<div id=""progress"" class=""layui-progress-bar layui-bg-green""></div>" & vbCrLf
	Response.Write "</div>" & vbCrLf
End Function

'----生成输出信息
Public Function progress(num, str)
	Response.Write "<script>progress.style.width=""" & num & "%"";progress.innerHTML=""<span class=\""layui-progress-text\"">" & num & "%</span>"";pstr.innerHTML=""" & str & """;</script>" & vbCrLf
	Response.Flush()
End Function	
'//*页面生成操作结束*//

'**************************************************
'函数名：GetArrFromDictionary
'作  用：从字典表获得区域值
'参  数：strTableName ---- 表名称
'        strFieldName ---- 区域名称
'返回值：查询区域值
'**************************************************
Public Function GetArrFromDictionary(strTableName, strFieldName)
	Dim rsDictionary, strTemp
	Call Exec(rsDictionary,"select FieldValue from Dictionary where TableName='" & strTableName & "' and FieldName='" & strFieldName & "'",2)
	If rsDictionary.BOF And rsDictionary.EOF Then
		strTemp = ""
	Else
		strTemp = rsDictionary(0) & ""
	End If
	Set rsDictionary = Nothing
	GetArrFromDictionary = Split(strTemp, "$$$")
End Function

'**************************************************
'函数名：GetFirstSeparatorToEnd
'作  用：截取从第一个分隔符到结尾的字符串
'参  数：str   ----原字符串
'        separator ----分隔符
'返回值：截取后的字符串
'**************************************************
Function GetFirstSeparatorToEnd(ByVal str, ByVal separator)
	GetFirstSeparatorToEnd = Right(str, Len(str) - InStr(str, separator))
End Function

'**************************************************
'函数名：ChkValidDays
'作  用：有效期的函数
'参  数：iValidNum ----有效期
'        iValidUnit ----有效期单位
'        iBeginTime ---- 开始计算日期
'返回值：剩余的有效天数
'**************************************************
Function ChkValidDays(iValidNum, iValidUnit, iBeginTime)
	If (iValidNum = "" Or IsNumeric(iValidNum) = False Or iValidUnit = "" Or IsNumeric(iValidUnit) = False Or iBeginTime = "" Or IsDate(iBeginTime) = False) Then
		ChkValidDays = 0
		Exit Function
	End If
	Dim tmpDate, arrInterval
	arrInterval = Array("h", "D", "m", "yyyy")
	If iValidNum = -1 Then
		ChkValidDays = 99999
	Else
		tmpDate = DateAdd(arrInterval(iValidUnit), iValidNum, iBeginTime)
		ChkValidDays = DateDiff("D", Date, tmpDate)
	End If
End Function

'**************************************************
'函数名：GetNumString
'作  用：获得项目随即数
'返回值：随机无重复的数字(用于上传,生成)
'**************************************************
Function GetNumString()
	Dim v_ymd, v_hms, v_mmm
	v_ymd = Year(Now) & Right("0" & Month(Now), 2) & Right("0" & Day(Now), 2)
	v_hms = Right("0" & Hour(Now), 2) & Right("0" & Minute(Now), 2) & Right("0" & Second(Now), 2)
	Randomize
	v_mmm = Right("0" & CStr(CLng(99 * Rnd) + 1), 2)
	GetNumString = v_ymd & v_hms & v_mmm
End Function

'**************************************************
'函数名：GetArrItem
'作  用：得到数组中某个元素的值
'参  数：arrTemp ---- 要取的数组
'        ItemIndex ---- 第几位数
'返回值：所属位数的元素
'**************************************************
Public Function GetArrItem(ByVal arrTemp, ByVal ItemIndex)
	If Not IsArray(arrTemp) Then
		GetArrItem = ""
		Exit Function
	End If
	ItemIndex = Code_CLng(ItemIndex)
	If ItemIndex < 0 Or ItemIndex > UBound(arrTemp) Then
		GetArrItem = ""
		Exit Function
	End If
	Dim strTemp
	strTemp = arrTemp(ItemIndex)
	If InStr(strTemp, "|") > 0 Then
		GetArrItem = Left(strTemp, InStr(strTemp, "|") - 1)
	Else
		GetArrItem = strTemp
	End If
End Function

'**************************************************
'函数名：Array2Option
'作  用：把数组变成下拉列表项目
'参  数：arrTemp ---- 数组
'        ItemIndex ---- 数组中默认的数字
'返回值：下拉菜单
'**************************************************
Public Function Array2Option(ByVal arrTemp, ByVal ID)
	Dim strOption, i, arrValue
	strOption = "<option value='-1'> </option>"
	ID = Code_CLng(ID)
	For i = 0 To UBound(arrTemp)
		arrValue = Split(arrTemp(i), "|")
		If CLng(arrValue(1)) = 1 Then
			If ID > -1 Then
				If i = ID Then
					strOption = strOption & "<option value='" & i & "' selected>" & arrValue(0) & "</option>"
				Else
					strOption = strOption & "<option value='" & i & "'>" & arrValue(0) & "</option>"
				End If
			Else
				If CLng(arrValue(2)) = 1 Then
					strOption = strOption & "<option value='" & i & "' selected>" & arrValue(0) & "</option>"
				Else
					strOption = strOption & "<option value='" & i & "'>" & arrValue(0) & "</option>"
				End If
			End If
		End If
	Next
	Array2Option = strOption
End Function

'**************************************************
'方法名：AddConsumeLog
'作  用：添加一条消费明细
'参  数：AdminName ----操作者,如无则为System
'        ModuleType---- 模型类型
'        strUserName ----用户名称
'        iInfoID ---- 项目ID,被扣除点数的信息ID
'        iPoint ---- 点数
'        Income_PayOut ---- 消费明细类型  1--收入  2--支出
'        strRemark ---- 备注/说明
'**************************************************
Sub AddConsumeLog(AdminName, ModuleType, strUserName, iInfoID, iPoint, Income_PayOut, strRemark)
	Dim rsConsumeLog, sqlConsumeLog
	sqlConsumeLog = "select top 1 * from ConsumeLog"
	Call Exe_Conn(rsConsumeLog,sqlConsumeLog,3)
	rsConsumeLog.addnew
	rsConsumeLog("UserName") = strUserName
	rsConsumeLog("ModuleType") = ModuleType
	rsConsumeLog("InfoID") = iInfoID
	rsConsumeLog("Point") = iPoint
	rsConsumeLog("Income_PayOut") = Income_PayOut
	rsConsumeLog("Remark") = strRemark
	rsConsumeLog("IP") = UserTrueIP
	rsConsumeLog("LogTime") = Now()
	rsConsumeLog("Times") = 1
	rsConsumeLog("Inputer") = AdminName
	rsConsumeLog.Update
	rsConsumeLog.Close
	Set rsConsumeLog = Nothing
End Sub

'**************************************************
'方法名：AddBankrollItem
'作  用：添加一条资金明细
'参  数：AdminName ----管理员名称
'        UserName ---- 用户名称
'        ClientID ----客户ID
'        Money ---- 金额
'        MoneyType ---- 类型  1--现金 2--汇款 3--在线支付  4--虚拟货币
'        Bank ---- 银行名称
'        eBankID ---- 网上支付平台ID
'        Income_PayOut ---- 类型  1--收入  2--支出  3--开户
'        OrderFormID ---- 支出时的订单ID
'        PaymentID ---- 在线支付的支付单ID
'        Remark ---- 备注
'        DateAndTime ---- 发生时间
'**************************************************
Sub AddBankrollItem(AdminName, UserName, ClientID, Money, MoneyType, Bank, eBankID, Income_PayOut, OrderFormID, PaymentID, Remark, DateAndTime)
	Dim rsBankroll, sqlBankroll
	sqlBankroll = "select top 1 * from BankrollItem"
	Call Exe_Conn(rsBankroll,sqlBankroll,3)
	rsBankroll.addnew
	rsBankroll("UserName") = UserName
	rsBankroll("ClientID") = ClientID
	rsBankroll("DateAndTime") = DateAndTime
	If Income_PayOut = 2 Then
		rsBankroll("Money") = 0 - Abs(Money)
	Else
		rsBankroll("Money") = Abs(Money)
	End If
	rsBankroll("MoneyType") = MoneyType
	rsBankroll("CurrencyType") = 1
	rsBankroll("Bank") = Bank
	rsBankroll("eBankID") = eBankID
	rsBankroll("Income_Payout") = Income_PayOut
	If OrderFormID = 0 Then
		rsBankroll("OrderFormID") = -GetRndNum(8)
	Else
		rsBankroll("OrderFormID") = OrderFormID
	End If
	rsBankroll("PaymentID") = PaymentID
	rsBankroll("Remark") = Remark
	rsBankroll("LogTime") = Now()
	rsBankroll("Inputer") = AdminName
	rsBankroll("IP") = UserTrueIP
	rsBankroll.Update
	rsBankroll.Close
	Set rsBankroll = Nothing
End Sub

'**************************************************
'方法名：AddRechargeLog
'作  用：添加一条有效期充值记录
'参  数：AdminName ----管理员名称
'        strUserName ---- 用户名称
'        iValidNum ----有效期
'        iValidUnit ----有效期单位
'        iIncome_Payout ---- 消费明细类型  1--收入  2--支出
'        strRemark ---- 备注/说明
'**************************************************
Sub AddRechargeLog(AdminName, strUserName, iValidNum, iValidUnit, iIncome_Payout, strRemark)
	Dim rsRechargeLog, sqlRechargeLog
	sqlRechargeLog = "select top 1 * from RechargeLog"
	Call Exe_Conn(rsRechargeLog,sqlRechargeLog,3)
	rsRechargeLog.addnew
	rsRechargeLog("UserName") = strUserName
	rsRechargeLog("ValidNum") = iValidNum
	rsRechargeLog("ValidUnit") = iValidUnit
	rsRechargeLog("Income_PayOut") = iIncome_Payout
	rsRechargeLog("Remark") = strRemark
	rsRechargeLog("LogTime") = Now()
	rsRechargeLog("IP") = UserTrueIP
	rsRechargeLog("Inputer") = AdminName
	rsRechargeLog.Update
	rsRechargeLog.Close
	Set rsRechargeLog = Nothing
End Sub

'**************************************************
'函数名：ShowJS_Main
'作  用：页面管理js(多项诓全选,删除提示)
'参  数：ItemName ---- 项目名称
'返回值：javascript 验证
'**************************************************
Public Sub ShowJS_Main(ItemName)
	Response.Write "<script language=javascript>" & vbCrLf
	Response.Write "function UnselectAll(){" & vbCrLf
	Response.Write "	if(document.myform.chkAll.checked){" & vbCrLf
	Response.Write "		document.myform.chkAll.checked = document.myform.chkAll.checked&0;" & vbCrLf
	Response.Write "	}" & vbCrLf
	Response.Write "}" & vbCrLf
	Response.Write "function CheckAll(form){" & vbCrLf
	Response.Write "	for (var i=0;i<form.elements.length;i++){" & vbCrLf
	Response.Write "	var e = form.elements[i];" & vbCrLf
	Response.Write "	if (e.Name != 'chkAll'&&e.disabled==false)" & vbCrLf
	Response.Write "		e.checked = form.chkAll.checked;" & vbCrLf
	Response.Write "	}" & vbCrLf
	Response.Write "}" & vbCrLf
	Response.Write "function ConfirmDel(){" & vbCrLf
	Response.Write "	if(document.myform.Action.value=='Del'){" & vbCrLf
	Response.Write "		if(confirm('确定要删除选中的" & ItemName & "吗？'))" & vbCrLf
	Response.Write "			return true;" & vbCrLf
	Response.Write "		else" & vbCrLf
	Response.Write "			return false;" & vbCrLf
	Response.Write "	}" & vbCrLf
	Response.Write "}" & vbCrLf
	Response.Write "</script>" & vbCrLf
End Sub

Function Salt(l1)
	dim l2,l3,i
	l2="0123456789abcdefghijklmnopqrstopwxyz"
	l3=len(l2)
	randomize
	for i=1 to l1
		Salt=Salt&mid(l2,round((rnd*(l3-1))+1),1)
	next
End Function

Function Safe(l1)
	if len(l1)>0 Then
		Safe=Replace(KillJaPan(trim(cstr(l1))),"'", "''")
	end if
End Function

Function KillJaPan(l1)
	on error resume next
	if king_dbtype=0 Then
		dim I1,I2,i,l2:l2=l1
		I1=array("ガ","ギ","グ","ア","ゲ","ゴ","ザ","ジ","ズ","ゼ","ゾ","ダ","ヂ","ヅ","デ","ド","バ","パ","ビ","ピ","ブ","プ","ベ","ペ","ボ","ポ","ヴ")
		I2=array("460","462","463","450","466","468","470","472","474","476","478","480","482","485","487","489","496","497","499","500","502","503","505","506","508","509","532")
		for i=0 to 26
			l2=Replace(l2,I1(i),"&#12"&I2(i)&";")
		next
		KillJaPan=l2
	else
		KillJaPan=l1
	end if
End Function

Function ValiDate(l1,l2)
	dim l3
	select case cstr(l2)
		case"0" l3="^[a-zA-Z0-9\,\/\-\_\[\]]+$"
		case"1" l3="^[A-Za-z]+$"
		case"2" l3="^\d+$"
		case"3" l3="^[A-Za-z0-9\_\-]+$"
		case"4" l3="^\w+([-+.]\w+)*@\w+([-.]\w+)*\.\w+([-.]\w+)*$"
		case"5" l3="^(http|https|ftp):(\/\/|\\\\)(([\w\/\\\+\-~`@:%])+\.)+([\w\/\\\.\=\?\+\-~`@\':!%#]|(&)|&)+"
		case"6" l3="^[0-9\,\.]+$"
		case"7" l3="^((http|https|ftp):(\/\/|\\\\)(([\w\/\\\+\-~`@:%])+\.)+([\w\/\\\.\=\?\+\-~`@\':!%#]|(&)|&)+|\/([\w\/\\\.\=\?\+\-~`@\':!%#]|(&)|&)+)\.(jpeg|jpg|gif|png|bmp)$"
		case"8" l3="^\w+\.(\w){1,30}$"
		case"9" l3="^((((1[6-9]|[2-9]\d)\d{2})-(0?[13578]|1[02])-(0?[1-9]|[12]\d|3[01]))|(((1[6-9]|[2-9]\d)\d{2})-(0?[13456789]|1[012])-(0?[1-9]|[12]\d|30))|(((1[6-9]|[2-9]\d)\d{2})-0?2-(0?[1-9]|1\d|2[0-8]))|(((1[6-9]|[2-9]\d)(0[48]|[2468][048]|[13579][26])|((16|[2468][048]|[3579][26])00))-0?2-29)) (20|21|22|23|[0-1]?\d):[0-5]?\d:[0-5]?\d$"
		case"10"
		l3="^(\d{1,2}|1\d\d|2[0-4]\d|25[0-5])\.(\d{1,2}|1\d\d|2[0-4]\d|25[0-5])\.(\d{1,2}|1\d\d|2[0-4]\d|25[0-5])\.(\d{1,2}|1\d\d|2[0-4]\d|25[0-5])$"
		case"11"
		l3="^\d?\.\d?\.\d?\.\d{4}$"
		case"12"
		l3="^((((1[6-9]|[2-9]\d)\d{2})-(0?[13578]|1[02])-(0?[1-9]|[12]\d|3[01]))|(((1[6-9]|[2-9]\d)\d{2})-(0?[13456789]|1[012])-(0?[1-9]|[12]\d|30))|(((1[6-9]|[2-9]\d)\d{2})-0?2-(0?[1-9]|1\d|2[0-8]))|(((1[6-9]|[2-9]\d)(0[48]|[2468][048]|[13579][26])|((16|[2468][048]|[3579][26])00))-0?2-29))$"
		case else l3=l2
	end select
	regEx.pattern=l3
	ValiDate=regEx.Test(trim(l1))
End Function

Public Function PinYin_Get(l1)
	dim I1,I2,l2,l3,i,rs
	'on error resume next
	for i=1 to len(l1)
		l2=mid(l1,i,1)
		if len(trim(l2))=1 Then     '长度为1

			l3=cdbl(asc(lcase(l2)))
			if l3>1 and l3<128 Then     '若为数字
				if ValiDate(l2,"^[A-Za-z0-9]+$") Then
					I1=I1&l2
				else
					I1=I1&" "
				end if
			else
				Call Exec(Rs,"select top 1 pinyin from PinYin where content like '%"&Safe(l2)&"%';",2)
				if not rs.eof and not rs.bof Then     '中文
					I1=I1&rs(0)
				else
					I1=I1&" "
				end if
				rs.close
				set rs=nothing
			end if
		else
			I1=I1&" "     '换行替换为空格
		end if
	next

	if len(I1)>0 Then
		I1=trim(I1)
		if len(I1)>0 Then
			I1=Replace(I1," ","_")
			while (instr(I1,"__"))
				I1=Replace(I1,"__","_")
			wend
		end if
	end if

	if len(trim(I1))>0 Then
		PinYin_Get=trim(I1)
	else
		PinYin_Get=Salt(10)
	end if
End Function

Public Function Get_PinYin(ByVal t0)
		t0=replace(t0," ","-")
		t0=replace(t0,"　","-")
		dim py
		set py=New PinYin
			Get_PinYin=py.PinYin(t0)
		set py=nothing
		Get_PinYin=left(Get_PinYin,50)
End Function

'**************************************************
'函数名：BatchReplaceString
'作  用：批量替换处理函数
'参  数：ItemContent ----数据
'参  数：ItemReplaceStart ----获得要替换的开头代码
'参  数：ItemReplaceEnd ----获得要替换的结束代码
'参  数：ItemReplaceResult ----要替换的代码
'参  数：ItemName ----类型名称
'返回值：True  ----已创建
'**************************************************
Function BatchReplaceString(ChannelTit, ItemContent, ItemReplaceStart, ItemReplaceEnd, ItemReplaceResult, ItemName, ID, Title)
	If InStr(ItemContent, ItemReplaceStart) = 0 Or InStr(ItemContent, ItemReplaceEnd) = 0 Then
		BatchReplaceString = ItemContent
		Exit Function
	End If
	If GetBody(ItemContent, ItemReplaceStart, ItemReplaceEnd, True, True) = "" Then
		BatchReplaceString = ItemContent
		Exit Function
	End If
	BatchReplaceString = Replace(ItemContent, GetBody(ItemContent, ItemReplaceStart, ItemReplaceEnd, True, True), ItemReplaceResult)
	Response.Write "<br>&nbsp;&nbsp;" & ChannelTit & "ID：" & ID & "&nbsp;&nbsp;" & Title & "..<font color='#009900'>" & ItemName & "替换成功！</font>"
End Function

'==================================================
'函数名：GetBody
'作  用：截取字符串
'参  数：ConStr ------将要截取的字符串
'参  数：StartStr ------开始字符串
'参  数：OverStr ------结束字符串
'参  数：IncluL ------是否包含StartStr
'参  数：IncluR ------是否包含OverStr
'==================================================
Function GetBody(ConStr, StartStr, OverStr, IncluL, IncluR)
	If ConStr = "$False$" Or ConStr = "" Or IsNull(ConStr) = True Or StartStr = "" Or IsNull(StartStr) = True Or OverStr = "" Or IsNull(OverStr) = True Then
		GetBody = "$False$"
		Exit Function
	End If
	Dim Start, Over
	Start = InStrB(1, ConStr, StartStr, vbBinaryCompare)
	If Start <= 0 Then
		Start = InStrB(1, ConStr, Replace(StartStr, vbCrLf, Chr(10)), vbBinaryCompare)
		If Start <= 0 Then
			Start = InStrB(1, ConStr, Replace(StartStr, vbCrLf, Chr(13)), vbBinaryCompare)
			If Start <= 0 Then
				GetBody = "$False$"
				Exit Function
			Else
				If IncluL = False Then
					Start = Start + LenB(StartStr)
				End If
			End If
		Else
			If IncluL = False Then
				Start = Start + LenB(StartStr)
			End If
		End If
	Else
		If IncluL = False Then
			Start = Start + LenB(StartStr)
		End If
	End If
	Over = InStrB(Start, ConStr, OverStr, vbBinaryCompare)
	If Over <= 0 Or Over <= Start Then
		Over = InStrB(Start, ConStr, Replace(OverStr, vbCrLf, Chr(10)), vbBinaryCompare)
		If Over <= 0 Or Over <= Start Then
			Over = InStrB(Start, ConStr, Replace(OverStr, vbCrLf, Chr(13)), vbBinaryCompare)
			If Over <= 0 Or Over <= Start Then
				GetBody = "$False$"
				Exit Function
			Else
				If IncluR = True Then
					Over = Over + LenB(OverStr)
				End If
			End If
		Else
			If IncluR = True Then
				Over = Over + LenB(OverStr)
			End If
		End If
	Else
		If IncluR = True Then
			Over = Over + LenB(OverStr)
		End If
	End If
	GetBody = MidB(ConStr, Start, Over - Start)
End Function

'**************************************************
'函数名：FilterArrNull
'作  用：过滤数组空字符
'**************************************************
Function FilterArrNull(ByVal ArrString, ByVal CompartString)
	Dim arrContent, arrTemp, i
	If CompartString = "" Or ArrString = "" Then
		FilterArrNull = ArrString
		Exit Function
	End If
	If InStr(ArrString, CompartString) = 0 Then
		FilterArrNull = ArrString
		Exit Function
	Else
		arrContent = Split(ArrString, CompartString)
		For i = 0 To UBound(arrContent)
			If Trim(arrContent(i)) <> "" Then
				If arrTemp = "" Then
					arrTemp = Trim(arrContent(i))
				Else
					arrTemp = arrTemp & CompartString & Trim(arrContent(i))
				End If
			End If
		Next
	End If
	FilterArrNull = arrTemp
End Function

'=================================================
'函数名：FilterJS()
'作  用：过滤非法JS字符
'参  数：strInput 需要过滤的内容
'=================================================
Function FilterJS(ByVal strInput)
	If IsNull(strInput) Or Trim(strInput) = "" Then
		FilterJS = ""
		Exit Function
	End If
	Dim reContent

	' 替换掉HTML字符实体(Character Entities)名字和分号之间的空白字符，比如：&auml    ;替换成&auml;
	regEx.Pattern = "(&#*\w+)[\x00-\x20]+;"
	strInput = regEx.Replace(strInput, "$1;")

	' 将无分号结束符的数字编码实体规范成带分号的标准形式
	regEx.Pattern = "(&#x*[0-9A-F]+);*"
	strInput = regEx.Replace(strInput, "$1;")

	' 将&nbsp; &lt; &gt; &amp; &quot;字符实体中的 & 替换成 &amp; 以便在进行HtmlDecode时保留这些字符实体
	'RegEx.Pattern = "&(amp|lt|gt|nbsp|quot);"
	'strInput = RegEx.Replace(strInput, "&amp;$1;")

	' 将HTML字符实体进行解码，以消除编码字符对后续过滤的影响
	'strInput = HtmlDecode(strInput);

	' 将ASCII码表中前32个字符中的非打印字符替换成空字符串，保留 9、10、13、32，它们分别代表 制表符、换行符、回车符和空格。
	regEx.Pattern = "[\x00-\x08\x0b-\x0c\x0e-\x19]"
	strInput = regEx.Replace(strInput, "")  
	
	oldhtmlString = ""
	Do While oldhtmlString <> strInput
		oldhtmlString = strInput
		regEx.Pattern = "(<[^>]+src[\x00-\x20]*=[\x00-\x20]*[^>]*?)&#([^>]*>)"  '过虑掉 src 里的 &#
		strInput = regEx.Replace(strInput, "$1&amp;#$2")
		regEx.Pattern = "(<[^>]+style[\x00-\x20]*=[\x00-\x20]*[^>]*?)&#([^>]*>)"  '过虑掉style 里的 &#
		strInput = regEx.Replace(strInput, "$1&amp;#$2")
		regEx.Pattern = "(<[^>]+style[\x00-\x20]*=[\x00-\x20]*[^>]*?)\\([^>]*>)"   '替换掉style中的 "\" 
		strInput = regEx.Replace(strInput, "$1/$2")  
	Loop
	' 替换以on和xmlns开头的属性，系统的几个JS需要保留
	regEx.Pattern = "on(load\s*=\s*""*'*resizepic\(this\)'*""*)"
	strInput = regEx.Replace(strInput, "off$1")
	regEx.Pattern = "on(mousewheel\s*=\s*""*'*return\s*bbimg\(this\)'*""*)"
	strInput = regEx.Replace(strInput, "off$1")

	regEx.Pattern = "(<[^>]+[\x00-\x20""'/])(on|xmlns)([^>]*)>"
	strInput = regEx.Replace(strInput, "$1pe$3>")

	regEx.Pattern = "off(load\s*=\s*""*'*resizepic\(this\)'*""*)"
	strInput = regEx.Replace(strInput, "on$1")
	regEx.Pattern = "off(mousewheel\s*=\s*""*'*return\s*bbimg\(this\)'*""*)"
	strInput = regEx.Replace(strInput, "on$1")

	' 替换javascript
	regEx.Pattern = "([a-z]*)[\x00-\x20]*=[\x00-\x20]*([`'""]*)[\x00-\x20]*j[\x00-\x20]*a[\x00-\x20]*v[\x00-\x20]*a[\x00-\x20]*s[\x00-\x20]*c[\x00-\x20]*r[\x00-\x20]*i[\x00-\x20]*p[\x00-\x20]*t[\x00-\x20]*:"
	strInput = regEx.Replace(strInput, "$1=$2nojavascript...")

	' 替换vbscript
	regEx.Pattern = "([a-z]*)[\x00-\x20]*=[\x00-\x20]*([`'""]*)[\x00-\x20]*v[\x00-\x20]*b[\x00-\x20]*s[\x00-\x20]*c[\x00-\x20]*r[\x00-\x20]*i[\x00-\x20]*p[\x00-\x20]*t[\x00-\x20]*:"
	strInput = regEx.Replace(strInput, "$1=$2novbscript...")

	'替换style中的注释部分，比如：<div style="xss:expres/*comment*/sion(alert(x))">
	regEx.Pattern = "(<[^>]+style[\x00-\x20]*=[\x00-\x20]*[^>]*?)/\*[^>]*\*/([^>]*>)"
	strInput = regEx.Replace(strInput, "$1$2")
	' 替换expression
	regEx.Pattern = "(<[^>]+)style[\x00-\x20]*=[\x00-\x20]*([`'""]*).*[eｅＥ][xｘＸ][pｐＰ][rｒＲ][eｅＥ][sｓＳ][sｓＳ][iｉＩ][oｏＯ][nｎＮ][\x00-\x20]*[\(\（][^>]*>"
	strInput = regEx.Replace(strInput, "$1>")

	' 替换behaviour
	regEx.Pattern = "(<[^>]+)style[\x00-\x20]*=[\x00-\x20]*([`'""]*).*behaviour[^>]*>>"
	strInput = regEx.Replace(strInput, "$1>")
	' 替换behavior
	regEx.Pattern = "(<[^>]+)style[\x00-\x20]*=[\x00-\x20]*([`'""]*).*behavior[^>]*>>"
	strInput = regEx.Replace(strInput, "$1>")

	' 替换script
	regEx.Pattern = "(<[^>]+)style[\x00-\x20]*=[\x00-\x20]*([`'""]*).*s[\x00-\x20]*c[\x00-\x20]*r[\x00-\x20]*i[\x00-\x20]*p[\x00-\x20]*t[\x00-\x20]*:*[^>]*>"
	strInput = regEx.Replace(strInput, "$1>")

	' 替换namespaced elements 不需要
	regEx.Pattern = "</*\w+:\w[^>]*>"
	strInput = regEx.Replace(strInput, "　")

	Dim oldhtmlString
	oldhtmlString = ""
	Do While oldhtmlString <> strInput
		oldhtmlString = strInput
		'实行严格过滤
		regEx.Pattern = "</*(applet|meta|xml|blink|link|style|script|embed|object|iframe|frame|frameset|ilayer|layer|bgsound|title|base)[^>]*>?"
		strInput = regEx.Replace(strInput, "　")
		'过滤掉SHTML的Include包含文件漏洞
		regEx.Pattern = "<!--\s*#include[^>]*>"
		strInput = regEx.Replace(strInput, "noshtml")
		'If FilterLevel > 0 Then
		'   '实行严格过滤
		'   RegEx.Pattern = "</*(embed|object)[^>]*>"
		'   strInput = RegEx.Replace(strInput, "")
		'End If
	Loop
	FilterJS = strInput
End Function

'**************************************************
'函数名：CheckPurview_Other
'作  用：其他权限数组检测
'参  数：AllPurviews ---- 要比较数组
'        strPurview ---- 比较字符
'返回值：True  ---- 存在
'**************************************************
Function CheckPurview_Other(AllPurviews, strPurview)
	If IsNull(AllPurviews) Or AllPurviews = "" Or strPurview = "" Then
		CheckPurview_Other = False
		Exit Function
	End If
	CheckPurview_Other = False
	If InStr(AllPurviews, ",") > 0 Then
		Dim arrPurviews, i
		arrPurviews = Split(AllPurviews, ",")
		For i = 0 To UBound(arrPurviews)
			If Trim(arrPurviews(i)) = Trim(strPurview) Then
				CheckPurview_Other = True
				Exit For
			End If
		Next
	Else
		If Trim(AllPurviews) = Trim(strPurview) Then
			CheckPurview_Other = True
		End If
	End If
End Function

Function StopInjection(Values)
	Dim FoundInjection
	regEx.Pattern = "'|;|#|([\s\b+()]+(select|update|insert|delete|declare|@|exec|dbcc|alter|drop|create|backup|if|else|end|and|or|add|set|open|close|use|begin|retun|as|go|exists)[\s\b+]*)"
	Dim sItem, sValue
	For Each sItem In Values
		sValue = Values(sItem)
		If regEx.Test(sValue) Then
			FoundInjection = True
			'Response.Write "很抱歉，由于您提交的内容中含有危险的SQL注入代码，致使本次操作无效！ "
			'Response.Write "<br>字段名：" & sItem
			'Response.Write "<br>字段值：" & sValue
			'Response.Write "<br>关键字："
			'Set Matches = regEx.Execute(sValue)
			'For Each Match In Matches
				'Response.Write FilterJS(Match.value)
			'Next
			'Response.Write "<br><br>如果您是正常提交仍出现上面的提示，请联系站长修改Conn.asp文件的第12行，暂时禁用掉防SQL注入功能，操作完成后再打开。"
			Response.Write "{""code"":0,""msg"":"""
			Response.Write "\u5f88\u62b1\u6b49\uff0c\u7531\u4e8e\u60a8\u63d0\u4ea4\u7684\u5185\u5bb9\u4e2d\u542b\u6709\u5371\u9669\u7684SQL\u6ce8\u5165\u4ee3\u7801\uff0c\u81f4\u4f7f\u672c\u6b21\u64cd\u4f5c\u65e0\u6548\uff01"
			Response.Write "<br>\u5b57\u6bb5\u540d\uff1a" & sItem
			'Response.Write "<br>\u5b57\u6bb5\u503c\uff1a" & sValue
			Response.Write "<br>\u5173\u952e\u5b57\uff1a"
			Set Matches = regEx.Execute(sValue)
			For Each Match In Matches
				Response.Write ToUnicode(FilterJS(Match.value))
			Next
			Response.Write "<br><br>\u5982\u679c\u60a8\u662f\u6b63\u5e38\u63d0\u4ea4\u4ecd\u51fa\u73b0\u4e0a\u9762\u7684\u63d0\u793a\uff0c\u8bf7\u8054\u7cfb\u7ad9\u957f\u4fee\u6539Conn.asp\u6587\u4ef6\u7684\u7b2c12\u884c\uff0c\u6682\u65f6\u7981\u7528\u6389\u9632SQL\u6ce8\u5165\u529f\u80fd\uff0c\u64cd\u4f5c\u5b8c\u6210\u540e\u518d\u6253\u5f00\u3002"
			Response.Write """}" & vbCrLf
		End If
	Next
	If FoundInjection = True Then
		Response.End()
	End If
End Function

Function StopInjection2(Values)
	Dim FoundInjection
	regEx.Pattern = "[';#()][\s+()]*(select|update|insert|delete|declare|@|exec|dbcc|alter|drop|create|backup|if|else|end|and|or|add|set|open|close|use|begin|retun|as|go|exists)[\s+]*"
	Dim sItem, sValue
	For Each sItem In Values
		sValue = Values(sItem)
		If regEx.Test(sValue) Then
			FoundInjection = True
			'Response.Write "很抱歉，由于您提交的内容中含有危险的SQL注入代码，致使本次操作无效！"
			'Response.Write "<br>字段名：" & sItem
			'Response.Write "<br>字段值：" & sValue
			'Response.Write "<br>关键字："
			'Set Matches = regEx.Execute(sValue)
			'For Each Match In Matches
				'Response.Write FilterJS(Match.value)
			'Next
			'Response.Write "<br><br>如果您是正常提交仍出现上面的提示，请联系站长修改Conn.asp文件的第12行，暂时禁用掉防SQL注入功能，操作完成后再打开。"
			Response.Write "{""code"":0,""msg"":"""
			Response.Write "\u5f88\u62b1\u6b49\uff0c\u7531\u4e8e\u60a8\u63d0\u4ea4\u7684\u5185\u5bb9\u4e2d\u542b\u6709\u5371\u9669\u7684SQL\u6ce8\u5165\u4ee3\u7801\uff0c\u81f4\u4f7f\u672c\u6b21\u64cd\u4f5c\u65e0\u6548\uff01"
			Response.Write "<br>\u5b57\u6bb5\u540d\uff1a" & sItem
			'Response.Write "<br>\u5b57\u6bb5\u503c\uff1a" & sValue
			Response.Write "<br>\u5173\u952e\u5b57\uff1a"
			Set Matches = regEx.Execute(sValue)
			For Each Match In Matches
				Response.Write ToUnicode(FilterJS(Match.value))
			Next
			Response.Write "<br><br>\u5982\u679c\u60a8\u662f\u6b63\u5e38\u63d0\u4ea4\u4ecd\u51fa\u73b0\u4e0a\u9762\u7684\u63d0\u793a\uff0c\u8bf7\u8054\u7cfb\u7ad9\u957f\u4fee\u6539Conn.asp\u6587\u4ef6\u7684\u7b2c12\u884c\uff0c\u6682\u65f6\u7981\u7528\u6389\u9632SQL\u6ce8\u5165\u529f\u80fd\uff0c\u64cd\u4f5c\u5b8c\u6210\u540e\u518d\u6253\u5f00\u3002"
			Response.Write """}" & vbCrLf
		End If
	Next
	If FoundInjection = True Then
		Response.End()
	End If
End Function

'**************************************************
'函数名：FoundInArr
'作  用：检测数组中是否有指定的数值
'参  数：strArr ----- 调入的数组
'        strItem  ----- 检测的字符
'        strSplit  ----- 分割字符
'返回值：True  ----有
'        False ----没有
'**************************************************
Function FoundInArr(strArr, strItem, strSplit)
	Dim arrTemp, arrTemp2, i, j
	FoundInArr = False
	If IsNull(strArr) Or IsNull(strItem) Or Trim(strArr) = "" Or Trim(strItem) = "" Then
		Exit Function
	End If
	If IsNull(strSplit) Or strSplit = "" Then
		strSplit = ","
	End If
	If InStr(Trim(strArr), strSplit) > 0 Then
		If InStr(Trim(strItem), strSplit) > 0 Then
			arrTemp = Split(strArr, strSplit)
			arrTemp2 = Split(strItem, strSplit)
			For i = 0 To UBound(arrTemp)
				For j = 0 To UBound(arrTemp2)
					If LCase(Trim(arrTemp2(j))) <> "" And LCase(Trim(arrTemp(i))) <> "" And LCase(Trim(arrTemp2(j))) = LCase(Trim(arrTemp(i))) Then
						FoundInArr = True
						Exit Function
					End If
				Next
			Next
		Else
			arrTemp = Split(strArr, strSplit)
			For i = 0 To UBound(arrTemp)
				If LCase(Trim(arrTemp(i))) = LCase(Trim(strItem)) Then
					FoundInArr = True
					Exit Function
				End If
			Next
		End If
	Else
		If LCase(Trim(strArr)) = LCase(Trim(strItem)) Then
			FoundInArr = True
		End If
	End If
End Function

'**************************************************
'函数名：FillInArrStr
'作  用：使用一个用逗号分隔的字符串来填充另外一个逗号分隔的字符串，使其达到指定的项目数
'参  数：strSource ---- 原字符串
'        strFill ---- 填充字符串
'        ItemNum ---- 指定填充后的项目数
'返回值：填充后的字符串
'**************************************************
Function FillInArrStr(ByVal strSource, ByVal strFill, ItemNum)
	Dim arrSource, arrFill, SourceItemNum, FillItemNum, i
	If IsNull(strSource) Or IsNull(strFill) Then
		FillInArrStr = ""
		Exit Function
	End If
	arrSource = Split(strSource, ",")
	arrFill = Split(strFill, ",")
	SourceItemNum = UBound(arrSource) + 1
	FillItemNum = UBound(arrFill) + 1
	If SourceItemNum < ItemNum And SourceItemNum + FillItemNum >= ItemNum Then
		For i = 0 To ItemNum - SourceItemNum - 1
			strSource = strSource & "," & arrFill(SourceItemNum + FillItemNum - ItemNum + i)
		Next
	End If
	FillInArrStr = strSource
End Function

'**************************************************
'函数名：GetRndPassword
'作  用：得到指定位数的随机数密码
'参  数：PasswordLen ---- 位数
'返回值：密码字符串
'**************************************************
Function GetRndPassword(PasswordLen)
	Dim Ran, i, strPassword
	strPassword = ""
	For i = 1 To PasswordLen
		Randomize
		Ran = CInt(Rnd * 2)
		Randomize
		If Ran = 0 Then
			Ran = CInt(Rnd * 25) + 97
			strPassword = strPassword & UCase(Chr(Ran))
		ElseIf Ran = 1 Then
			Ran = CInt(Rnd * 9)
			strPassword = strPassword & Ran
		ElseIf Ran = 2 Then
			Ran = CInt(Rnd * 25) + 97
			strPassword = strPassword & Chr(Ran)
		End If
	Next
	GetRndPassword = strPassword
End Function

'**************************************************
'函数名：GetRndNum
'作  用：产生制定位数的随机数
'参  数：iLength ---- 随即数的位数
'返回值：随机数
'**************************************************
Function GetRndNum(iLength)
	Dim i, Str
	For i = 1 To (iLength \ 5 + 1)
		Randomize
		Str = Str & CStr(CLng(Rnd * 90000) + 10000)
	Next
	GetRndNum = Left(Str, iLength)
End Function

'**************************************************
'函数名：IsValidEmail
'作  用：检查Email地址合法性
'参  数：email ----要检查的Email地址
'返回值：True  ----Email地址合法
'        False ----Email地址不合法
'**************************************************
Function IsValidEmail(Email)
	regEx.Pattern = "^\w+((-\w+)|(\.\w+))*\@[A-Za-z0-9]+((\.|-)[A-Za-z0-9]+)*\.[A-Za-z0-9]+$"
	IsValidEmail = regEx.Test(Email)
End Function

'**************************************************
'函数名：ReplaceBadChar
'作  用：过滤非法的SQL字符
'参  数：strChar-----要过滤的字符
'返回值：过滤后的字符
'**************************************************
Function ReplaceBadChar(strChar)
	If strChar = "" Or IsNull(strChar) Then
		ReplaceBadChar = ""
		Exit Function
	End If
	Dim strBadChar, arrBadChar, tempChar, i
	strBadChar = "+,',%,^,&,?,(,),<,>,[,],{,},/,\,;,:," & Chr(34) & "," & Chr(0) & ",--"
	arrBadChar = Split(strBadChar, ",")
	tempChar = strChar
	For i = 0 To UBound(arrBadChar)
		tempChar = Replace(tempChar, arrBadChar(i), "")
	Next
	tempChar = Replace(tempChar, "@@", "@")
	ReplaceBadChar = tempChar
End Function

'**************************************************
'函数名：ReplaceLabelBadChar
'作  用：函数标签过滤非法的SQL字符
'参  数：strChar-----要过滤的字符
'返回值：过滤后的字符
'**************************************************
Function ReplaceLabelBadChar(strChar)
	If strChar = "" Or IsNull(strChar) Then
		ReplaceLabelBadChar = ""
		Exit Function
	End If
	Dim strBadChar, arrBadChar, tempChar, i
	strBadChar = "+,',%,^,&,?,(,),<,>,[,],{,},/,\,;,:," & Chr(34) & "," & Chr(0)
	arrBadChar = Split(strBadChar, ",")
	tempChar = strChar
	For i = 0 To UBound(arrBadChar)
		tempChar = Replace(tempChar, arrBadChar(i), "")
	Next
	tempChar = Replace(tempChar, "@@", "@")
	Dim oldString
	oldString = ""
	Do While oldString <> tempChar
		oldString = tempChar
		regEx.Pattern = "(select|union|update|insert|delete|exec|from|admin|--)?"
		tempChar = regEx.Replace(tempChar, "")
	Loop
	ReplaceLabelBadChar = tempChar
End Function

'**************************************************
'函数名：CheckBadChar
'作  用：检查是否包含非法的SQL字符
'参  数：strChar-----要检查的字符
'返回值：True  ----字符合法
'        False ----字符不合法
'**************************************************
Function CheckBadChar(strChar)
	Dim strBadChar, arrBadChar, i
	strBadChar = "@@,+,',%,^,&,?,(,),<,>,[,],{,},/,\,;,:," & Chr(34) & ",--,union,select,insert,delete,from,admin"
	arrBadChar = Split(strBadChar, ",")
	If strChar = "" Then
		CheckBadChar = False
	Else
		Dim tempChar
		tempChar = LCase(strChar)
		For i = 0 To UBound(arrBadChar)
			If InStr(tempChar, arrBadChar(i)) > 0 Then
				CheckBadChar = False
				Exit Function
			End If
		Next
	End If
	CheckBadChar = True
End Function

'**************************************************
'函数名：ToUnicode
'作  用：中文转unicode
'参  数：str-----字符
'**************************************************
Function ToUnicode(str)
	ToUnicode = ""
	Dim i
	For i=1 to len(str)
		'asc函数：返回字符串的第一个字母对应的ANSI字符代码
		'AscW函数：返回每一个GB编码文字的Unicode字符代码
		'hex函数：返回表示十六进制数字值的字符串
		ToUnicode = ToUnicode & "\u" & LCase(Right("0000" & Cstr(hex(AscW(mid(str,i,1)))),4))
	Next
End Function

'**************************************************
'函数名：UnicodeTo
'作  用：unicode转中文
'参  数：str-----字符
'**************************************************
Function UnicodeTo(str)
	str=Replace(str,"\u","")
	UnicodeTo = ""
	Dim i
	For i=1 to len(str) step 4
		'cint函数：将Variant类型强制转换成int类型
		'chr函数：返回数值对应的ANSI编码字符
		'ChrW函数：返回数值对应的Unicode编码字符
		UnicodeTo = UnicodeTo & ChrW(cint("&H" & mid(str,i,4)))
	Next
End Function

'**************************************************
'函数名：NoHtml
'作  用：过滤html 元素
'参  数：str ---- 要过滤字符
'返回值：没有html 的字符
'**************************************************
Function NoHtml(ByVal str)
	If IsNull(str) Or Trim(str) = "" Then
		NoHtml = ""
		Exit Function
	End If
	regEx.Pattern = "(\<.[^\<]*\>)"
	str = regEx.Replace(str, "")
	regEx.Pattern = "(\<\/[^\<]*\>)"
	str = regEx.Replace(str, "")
	regEx.Pattern = "\[NextPage(.*?)\]"   '解决“当在文章模块的模型中发布的是图片并使用分页标签[NextPage]或内容开始的前几行就使用分页标签时，一旦使用搜索来搜索该文时，搜索页就会显示分页标签”的问题
	str = regEx.Replace(str, "")
	
	str = Replace(str, "'", "")
	str = Replace(str, Chr(34), "")
	str = Replace(str, vbCrLf, "")
	str = Trim(str)
	NoHtml = str
End Function

'**************************************************
'函数名：GetSubStr
'作  用：截字符串，汉字一个算两个字符，英文算一个字符
'参  数：str   ----原字符串
'        strlen ----截取长度
'        bShowPoint ---- 是否显示省略号
'返回值：截取后的字符串
'**************************************************
Function GetSubStr(ByVal str, ByVal strlen, bShowPoint)
	If IsNull(str) Or str = "" Then
		GetSubStr = ""
		Exit Function
	End If
	Dim l, t, c, i, strTemp
	str = Replace(Replace(Replace(Replace(str, "&nbsp;", " "), "&quot;", Chr(34)), "&gt;", ">"), "&lt;", "<")
	l = Len(str)
	t = 0
	strTemp = str
	strlen = Code_CLng(strlen)
	For i = 1 To l
		c = Abs(Asc(Mid(str, i, 1)))
		If c > 255 Then
			t = t + 2
		Else
			t = t + 1
		End If
		If t >= strlen Then
			strTemp = Left(str, i)
			Exit For
		End If
	Next
	str = Replace(Replace(Replace(Replace(str, " ", "&nbsp;"), Chr(34), "&quot;"), ">", "&gt;"), "<", "&lt;")
	strTemp = Replace(Replace(Replace(Replace(strTemp, " ", "&nbsp;"), Chr(34), "&quot;"), ">", "&gt;"), "<", "&lt;")
	If strTemp <> str And bShowPoint = True Then
		strTemp = strTemp & "…"
	End If
	GetSubStr = strTemp
End Function

'**************************************************
'函数名：JoinChar
'作  用：向地址中加入 ? 或 &
'参  数：strUrl  ----网址
'返回值：加了 ? 或 & 的网址
'**************************************************
Function JoinChar(ByVal strUrl)
	If strUrl = "" Then
		JoinChar = ""
		Exit Function
	End If
	If InStr(strUrl, "?") < Len(strUrl) Then
		If InStr(strUrl, "?") > 1 Then
			If InStr(strUrl, "&") < Len(strUrl) Then
				JoinChar = strUrl & "&"
			Else
				JoinChar = strUrl
			End If
		Else
			JoinChar = strUrl & "?"
		End If
	Else
		JoinChar = strUrl
	End If
End Function

'分页两侧
Function pageNumberLinkInfo(Byval currentPage,Byval pageListLen,Byval totalNumber,Byval totalPages,Byval linkType, Byval strUnit)
	dim pageNumber,pagesStr,i,pageNumberInfo,firstPageLink,lastPagelink,nextPagelink,finalPageLink,p,jumppagelink,currentpagestr
	pageNumber=makePageNumber(currentPage,pageListLen,totalNumber,totalPages,linkType,strUnit)		
	if currentPage=1 then  
		firstPageLink="<span class='nolink'>首页</span>" : lastPagelink="<span class='nolink'>上一页</span>"
	else
		firstPageLink="<a href='"&linkType&"&Page=1'>首页</a>" : if currentPage>2 then lastPagelink="<a href='"&linkType&"&Page="&currentPage-1&"'>上一页</a>" : else lastPagelink="<a href='"&linkType&"&Page=1"&"'>上一页</a>"		
	end if 
	jumppagelink="转到&nbsp;<select name=""select"" onchange=""var jmpURL=this.options[this.selectedIndex].value ; if(jmpURL!='') {window.location=jmpURL;} else {this.selectedIndex=0 ;}"" >"
	for p=1 to totalPages
		currentpagestr=""
		if currentPage=p then currentpagestr=" selected=selected"
		jumppagelink=jumppagelink&"<option value="""&linkType&"&Page="&p&""""&currentpagestr&">"&p&"</option>"
	next
	jumppagelink=jumppagelink&"</select>"
	if currentPage=totalPages then
		nextPagelink="<span class='nolink'>下一页</span>" : finalPageLink="<span class='nolink'>尾页</span>"
	else
		nextPagelink="<a href='"&linkType&"&Page="&currentPage+1&"'>下一页</a>" : finalPageLink="<a href='"&linkType&"&Page="&totalPages&"'>尾页</a>"
	end if
	pageNumberInfo="<span>共&nbsp;<b>" & totalNumber & "</b>&nbsp;" & strUnit & "&nbsp;&nbsp;&nbsp;共&nbsp;"&totalPages&"&nbsp;页&nbsp;&nbsp;&nbsp;页次:"&currentPage&"/"&totalPages&"&nbsp;页</span>&nbsp;&nbsp;"&firstPageLink&lastPagelink&pageNumber&""&nextPagelink&""&finalPagelink&"&nbsp;&nbsp;&nbsp;"&jumppagelink
	pageNumberLinkInfo=pageNumberInfo
End Function

'分页中部
Function makePageNumber(Byval currentPage,Byval pageListLen,Byval totalNumber,Byval totalPages,Byval linkType, Byval strUnit)
	dim beforePages,pagenumber,page
	dim beginPage,endPage,strPageNumber
	if pageListLen mod 2 = 0 then beforePages = pagelistLen / 2 else beforePages = clng(pagelistLen / 2) - 1
	if  currentPage < 1  then currentPage = 1 else if currentPage > totalPages then currentPage = totalPages
	if pageListLen > totalPages then pageListLen=totalPages
	if currentPage - beforePages < 1 then
		beginPage = 1 : endPage = pageListLen
	elseif currentPage - beforePages + pageListLen > totalPages  then
		beginPage = totalPages - pageListLen + 1 : endPage = totalPages
	else
		beginPage = currentPage - beforePages : endPage = currentPage - beforePages + pageListLen - 1
	end if
'	die currentPage
	for pagenumber = beginPage  to  endPage
		if pagenumber=1 then page = "" else page = pagenumber
		if pagenumber=currentPage then
			strPageNumber=strPageNumber&"<span><font color=red>"&pagenumber&"</font></span>"
		else
			strPageNumber=strPageNumber&"<a href="""&linkType&"&Page="&pagenumber&""">"&pagenumber&"</a>"
		end if
	next
	makePageNumber=strPageNumber
End Function

'分页两侧
Function pageNumberLinkInfo_Html(Byval currentPage,Byval pageListLen,Byval totalNumber,Byval totalPages,Byval linkType, Byval FileExt, Byval strUnit)
	dim pageNumber,pagesStr,i,pageNumberInfo,firstPageLink,lastPagelink,nextPagelink,finalPageLink,p,jumppagelink,currentpagestr
	pageNumber=makePageNumber_Html(currentPage,pageListLen,totalNumber,totalPages,linkType,FileExt,strUnit)		
	if currentPage=1 then  
		firstPageLink="<span class='nolink'>首页</span>" : lastPagelink="<span class='nolink'>上一页</span>"
	else
		firstPageLink="<a href='" & linkType & "/'>首页</a>" : if currentPage>2 then lastPagelink="<a href='" & linkType & "Index_" & currentPage-1 & FileExt & "'>上一页</a>" : else lastPagelink="<a href='"&linkType&"/"&"'>上一页</a>"		
	end if 
	jumppagelink="转到&nbsp;<select name=""select"" onchange=""var jmpURL=this.options[this.selectedIndex].value ; if(jmpURL!='') {window.location=jmpURL;} else {this.selectedIndex=0 ;}"" >"
	for p=1 to totalPages
		currentpagestr=""
		if currentPage=p then currentpagestr=" selected=selected"
		jumppagelink=jumppagelink&"<option value=""" & linkType & "Index_" & p & FileExt & """"&currentpagestr&">"&p&"</option>"
	next
	jumppagelink=jumppagelink&"</select>"
	if currentPage=totalPages then
		nextPagelink="<span class='nolink'>下一页</span>" : finalPageLink="<span class='nolink'>尾页</span>"
	else
		nextPagelink="<a href='" & linkType & "Index_" & currentPage+1 & FileExt & "'>下一页</a>" : finalPageLink="<a href='" & linkType & "Index_" & totalPages & FileExt & "'>尾页</a>"
	end if
	pageNumberInfo="<span>共&nbsp;<b>" & totalNumber & "</b>&nbsp;" & strUnit & "&nbsp;&nbsp;&nbsp;共&nbsp;"&totalPages&"&nbsp;页&nbsp;&nbsp;&nbsp;页次:"&currentPage&"/"&totalPages&"&nbsp;页</span>&nbsp;&nbsp;"&firstPageLink&lastPagelink&pageNumber&""&nextPagelink&""&finalPagelink&"&nbsp;&nbsp;&nbsp;"&jumppagelink
	pageNumberLinkInfo_Html=pageNumberInfo
End Function

'分页中部
Function makePageNumber_Html(Byval currentPage,Byval pageListLen,Byval totalNumber,Byval totalPages,Byval linkType, Byval FileExt, Byval strUnit)
	dim beforePages,pagenumber,page
	dim beginPage,endPage,strPageNumber
	if pageListLen mod 2 = 0 then beforePages = pagelistLen / 2 else beforePages = clng(pagelistLen / 2) - 1
	if  currentPage < 1  then currentPage = 1 else if currentPage > totalPages then currentPage = totalPages
	if pageListLen > totalPages then pageListLen=totalPages
	if currentPage - beforePages < 1 then
		beginPage = 1 : endPage = pageListLen
	elseif currentPage - beforePages + pageListLen > totalPages  then
		beginPage = totalPages - pageListLen + 1 : endPage = totalPages
	else
		beginPage = currentPage - beforePages : endPage = currentPage - beforePages + pageListLen - 1
	end if
'	die currentPage
	for pagenumber = beginPage  to  endPage
		if pagenumber=1 then page = "" else page = pagenumber
		if pagenumber=currentPage then
			strPageNumber=strPageNumber&"<span><font color=red>"&pagenumber&"</font></span>"
		else
			strPageNumber=strPageNumber&"<a href=""" & linkType & "Index_" & pagenumber & FileExt & """>"&pagenumber&"</a>"
		end if
	next
	makePageNumber_Html=strPageNumber
End Function

'**************************************************
'函数名：ShowPage
'作  用：显示“上一页 下一页”等信息
'参  数：sFileName  ----链接地址
'        TotalNumber ----总数量
'        MaxPerPage  ----每页数量
'        CurrentPage ----当前页
'        ShowTotal   ----是否显示总数量
'        ShowAllPages ---是否用下拉列表显示所有页面以供跳转。
'        strUnit     ----计数单位
'        ShowMaxPerPage  ----是否显示每页信息量选项框
'返回值：“上一页 下一页”等信息的HTML代码
'**************************************************
Function ShowPage(sfilename, totalnumber, MaxPerPage, CurrentPage, ShowTotal, ShowAllPages, strUnit, ShowMaxPerPage)
	Dim TotalPage, strTemp, strUrl, i
	
	If totalnumber = 0 Or MaxPerPage = 0 Or IsNull(MaxPerPage) Then
		ShowPage = ""
		Exit Function
	End If
	If totalnumber Mod MaxPerPage = 0 Then
		TotalPage = totalnumber \ MaxPerPage
	Else
		TotalPage = totalnumber \ MaxPerPage + 1
	End If
	If CurrentPage > TotalPage Then CurrentPage = TotalPage
	strTemp = "<div class=""show_page"">"
	If ShowTotal = True Then
		strTemp = strTemp & "共&nbsp;<b>" & totalnumber & "</b>&nbsp;" & strUnit & "&nbsp;&nbsp;&nbsp;"
	End If
	
	If ShowMaxPerPage = True Then
		strUrl = JoinChar(sfilename) & "MaxPerPage=" & MaxPerPage & "&"
	Else
		strUrl = JoinChar(sfilename)
	End If
	If CurrentPage = 1 Then
		strTemp = strTemp & "首页&nbsp;|&nbsp;上一页&nbsp;|"
	Else
		strTemp = strTemp & "<a href='" & strUrl & "Page=1'>首页</a>&nbsp;|"
		strTemp = strTemp & "&nbsp;<a href='" & strUrl & "Page=" & (CurrentPage - 1) & "'>上一页</a>&nbsp;|&nbsp;"
	End If
	strTemp = strTemp & "&nbsp;"
	If ShowAllPages = True Then
		Dim Jmaxpages
		If (CurrentPage - 4) <= 0 Or TotalPage < 10 Then
			Jmaxpages = 1
			Do While (Jmaxpages < 10)
				If Jmaxpages = CurrentPage Then
					strTemp = strTemp & "<font color=""FF0000"">" & Jmaxpages & "</font>&nbsp;"
				Else
					If strUrl <> "" Then
						strTemp = strTemp & "<a href=""" & strUrl & "Page=" & Jmaxpages & """>" & Jmaxpages & "</a>&nbsp;"
					End If
				End If
				If Jmaxpages = TotalPage Then Exit Do
				Jmaxpages = Jmaxpages + 1
			Loop
		ElseIf (CurrentPage + 4) >= TotalPage Then
			Jmaxpages = TotalPage - 8
			Do While (Jmaxpages <= TotalPage)
				If Jmaxpages = CurrentPage Then
					strTemp = strTemp & "<font color=""FF0000"">" & Jmaxpages & "</font>&nbsp;"
				Else
					If strUrl <> "" Then
						strTemp = strTemp & "<a href=""" & strUrl & "Page=" & Jmaxpages & """>" & Jmaxpages & "</a>&nbsp;"
					End If
				End If
				Jmaxpages = Jmaxpages + 1
			Loop
		Else
			Jmaxpages = CurrentPage - 4
			Do While (Jmaxpages < CurrentPage + 5)
				If Jmaxpages = CurrentPage Then
					strTemp = strTemp & "<font color=""FF0000"">" & Jmaxpages & "</font>&nbsp;"
				Else
					If strUrl <> "" Then
						strTemp = strTemp & "<a href=""" & strUrl & "Page=" & Jmaxpages & """>" & Jmaxpages & "</a>&nbsp;"
					End If
				End If
				Jmaxpages = Jmaxpages + 1
			Loop
		End If
	End If
	If CurrentPage >= TotalPage Then
		strTemp = strTemp & "|&nbsp;下一页&nbsp;|&nbsp;尾页"
	Else
		strTemp = strTemp & "&nbsp;|&nbsp;<a href='" & strUrl & "Page=" & (CurrentPage + 1) & "'>下一页</a>&nbsp;|"
		strTemp = strTemp & "&nbsp;<a href='" & strUrl & "Page=" & TotalPage & "'>尾页</a>"
	End If
	If ShowMaxPerPage = True Then
		strTemp = strTemp & "&nbsp;&nbsp;&nbsp;<Input type='text' name='MaxPerPage' size='3' maxlength='4' value='" & MaxPerPage & "' onKeyPress=""if (event.keyCode==13) window.location='" & JoinChar(sfilename) & "Page=" & CurrentPage & "&MaxPerPage='+this.value;"">" & strUnit & "/页"
	Else
		strTemp = strTemp & "&nbsp;<b>" & MaxPerPage & "</b>" & strUnit & "/页"
	End If
	If ShowAllPages = True Then
		strTemp = strTemp & "&nbsp;&nbsp;转到第<Input type='text' name='Page' size='3' maxlength='5' value='" & CurrentPage & "' onKeyPress=""if (event.keyCode==13) window.location='" & strUrl & "Page='+this.value;"">页"
	End If
	strTemp = strTemp & "</div>"
	ShowPage = strTemp
End Function

'**************************************************
'函数名：ShowPage_Html
'作  用：显示"上一页 下一页"等信息
'参  数：strPath ----HTMl文件的路径
'        iClassID  ----栏目ID
'        FileExt ----- 扩展名
'        sfilename  ---- 文件名
'        TotalNumber ----总数量
'        MaxPerPage  ----每页数量
'        ShowTotal   ----是否显示总数量
'        ShowAllPages ---是否用下拉列表显示所有页面以供跳转。有某些页面不能使用，否则会出现JS错误。
'        strUnit     ----计数单位
'返回值："上一页 下一页"等信息的HTML代码
'**************************************************
Function ShowPage_Html(ByVal strPath, iClassID, FileExt, sfilename, totalnumber, MaxPerPage, CurrentPage, ShowTotal, ShowAllPages, strUnit)
	Dim TotalPage, strTemp, strUrl, i
	If totalnumber = 0 Or MaxPerPage = 0 Or IsNull(MaxPerPage) Then
		ShowPage_Html = ""
		Exit Function
	End If
	If totalnumber Mod MaxPerPage = 0 Then
		TotalPage = totalnumber \ MaxPerPage
	Else
		TotalPage = totalnumber \ MaxPerPage + 1
	End If
	If CurrentPage > TotalPage Then CurrentPage = TotalPage
	If sfilename <> "" Then
		strUrl = JoinChar(sfilename)
	Else
		strUrl = ""
	End If
	If Right(strPath, 1) = "/" Then
		strPath = Left(strPath, Len(strPath) - 1)
	End If
	strTemp = strTemp & "<div class=""showpage"">"
	If ShowTotal = True Then
		strTemp = strTemp & "共&nbsp;<b>" & totalnumber & "</b>&nbsp;"& strUnit & "&nbsp;&nbsp;"
	End If
	If CurrentPage = 1 Then
		strTemp = strTemp & "首页&nbsp;|&nbsp;上一页&nbsp;|"
	Else
		If iClassID > 0 Then
			strTemp = strTemp & "<a href='" & strPath & "/Index_" & iClassID & FileExt & "'>首页</a>&nbsp;|"
		Else
			strTemp = strTemp & "<a href='" & strPath & "/'>首页</a>&nbsp;|"
		End If
		If CurrentPage = 2 Then
			If iClassID > 0 Then
				strTemp = strTemp & "&nbsp;<a href='" & strPath & "/Index_" & iClassID & FileExt & "'>上一页</a>&nbsp;|"
			Else
				strTemp = strTemp & "&nbsp;<a href='" & strPath & "/'>上一页</a>&nbsp;|"
			End If
		Else
			If strUrl <> "" Then
				strTemp = strTemp & "&nbsp;<a href='" & strUrl & "page=" & (CurrentPage - 1) & "'>上一页</a>&nbsp;|"
			Else
				If iClassID > 0 Then
					strTemp = strTemp & "&nbsp;<a href='" & strPath & "/Index_" & iClassID & "_" & CurrentPage - 1 & FileExt & "'>上一页</a>&nbsp;|"
				Else
					strTemp = strTemp & "&nbsp;<a href='" & strPath & "/Index_" & CurrentPage - 1 & FileExt & "'>上一页</a>&nbsp;|"
				End If
			End If
		End If
	End If
	strTemp = strTemp & "&nbsp;"
	If ShowAllPages = True Then
		Dim Jmaxpages
		If (CurrentPage - 4) <= 0 Or TotalPage < 10 Then
			Jmaxpages = 1
			Do While (Jmaxpages < 10)
				If Jmaxpages = CurrentPage Then
					strTemp = strTemp & "<font color=""FF0000"">" & Jmaxpages & "</font>&nbsp;"
				ElseIf Jmaxpages = 1 Then
					If iClassID > 0 Then
						strTemp = strTemp & "<a href=""" & strPath & "/Index_" & iClassID & FileExt & """>" & Jmaxpages & "</a>&nbsp;"
					Else
						strTemp = strTemp & "<a href=""" & strPath & "/"">" & Jmaxpages & "</a>&nbsp;"
					End If
				Else
					If strUrl <> "" Then
						strTemp = strTemp & "<a href=""" & strUrl & "page=" & Jmaxpages & """>" & Jmaxpages & "</a>&nbsp;"
					Else
						If iClassID > 0 Then
							strTemp = strTemp & "<a href=""" & strPath & "/Index_" & iClassID & "_" & Jmaxpages & FileExt & """>" & Jmaxpages & "</a>&nbsp;"
						Else
							strTemp = strTemp & "<a href=""" & strPath & "/Index_" & Jmaxpages & FileExt & """>" & Jmaxpages & "</a>&nbsp;"
						End If
					End If
				End If
				If Jmaxpages = TotalPage Then Exit Do
				Jmaxpages = Jmaxpages + 1
			Loop
		ElseIf (CurrentPage + 4) >= TotalPage Then
			Jmaxpages = TotalPage - 8
			Do While (Jmaxpages <= TotalPage)
				If Jmaxpages = CurrentPage Then
					strTemp = strTemp & "<font color=""FF0000"">" & Jmaxpages & "</font>&nbsp;"
				ElseIf Jmaxpages = 1 Then
					If iClassID > 0 Then
						strTemp = strTemp & "<a href=""" & strPath & "/Index_" & iClassID & FileExt & """>" & Jmaxpages & "</a>&nbsp;"
					Else
						strTemp = strTemp & "<a href=""" & strPath & "/"">" & Jmaxpages & "</a>&nbsp;"
					End If
				Else
					If strUrl <> "" Then
						strTemp = strTemp & "<a href=""" & strUrl & "page=" & Jmaxpages & """>" & Jmaxpages & "</a>&nbsp;"
					Else
						If iClassID > 0 Then
							strTemp = strTemp & "<a href=""" & strPath & "/Index_" & iClassID & "_" & Jmaxpages & FileExt & """>" & Jmaxpages & "</a>&nbsp;"
						Else
							strTemp = strTemp & "<a href=""" & strPath & "/Index_" & TotalPage - Jmaxpages & FileExt & """>" & Jmaxpages & "</a>&nbsp;"
						End If
					End If
				End If
				Jmaxpages = Jmaxpages + 1
			Loop
		Else
			Jmaxpages = CurrentPage - 4
			Do While (Jmaxpages < CurrentPage + 5)
				If Jmaxpages = CurrentPage Then
					strTemp = strTemp & "<font color=""FF0000"">" & Jmaxpages & "</font>&nbsp;"
				ElseIf Jmaxpages = 1 Then
					If iClassID > 0 Then
						strTemp = strTemp & "<a href=""" & strPath & "/Index_" & iClassID & FileExt & """>" & Jmaxpages & "</a>&nbsp;"
					Else
						strTemp = strTemp & "<a href=""" & strPath & "/"">" & Jmaxpages & "</a>&nbsp;"
					End If
				Else
					If strUrl <>"" Then
						strTemp = strTemp & "<a href=""" & strUrl & "page=" & Jmaxpages & """>" & Jmaxpages & "</a>&nbsp;"
					Else
						If iClassID > 0 Then
							strTemp = strTemp & "<a href=""" & strPath & "/Index_" & iClassID & "_" & Jmaxpages & FileExt & """>" & Jmaxpages & "</a>&nbsp;"
						Else
							strTemp = strTemp & "<a href=""" & strPath & "/Index_" & Jmaxpages & FileExt & """>" & Jmaxpages & "</a>&nbsp;"
						End If
					End If
				End If
				Jmaxpages = Jmaxpages + 1
			Loop
		End If
	End If

	If CurrentPage >= TotalPage Then
		strTemp = strTemp & "|&nbsp;下一页&nbsp;|&nbsp;尾页"
	Else
		If strUrl <>"" Then
			strTemp = strTemp & "|&nbsp;<a href='" & strUrl & "page=" & (CurrentPage + 1) & "'>下一页</a>&nbsp;"
			strTemp = strTemp & "|&nbsp;<a href='" & strUrl & "page=" & TotalPage & "'>尾页</a>"
		Else
			If iClassID > 0 Then
				strTemp = strTemp & "|&nbsp;<a href='" & strPath & "/Index_" & iClassID & "_" & CurrentPage + 1 & FileExt & "'>下一页</a>&nbsp;"
				strTemp = strTemp & "|&nbsp;<a href='" & strPath & "/Index_" & iClassID & "_" & TotalPage & FileExt & "'>尾页</a>"
			Else
				strTemp = strTemp & "|&nbsp;<a href='" & strPath & "/Index_" & CurrentPage + 1 & FileExt & "'>下一页</a>&nbsp;"
				strTemp = strTemp & "|&nbsp;<a href='" & strPath & "/Index_" & TotalPage & FileExt & "'>尾页</a>"
			End If
		End If
	End If
	strTemp = strTemp & "&nbsp;<b>" & MaxPerPage & "</b>" & strUnit & "/页"
	If ShowAllPages = True Then
		strTemp = strTemp & "&nbsp;&nbsp;转到第<Input type='text' name='page' size='3' maxlength='5' value='" & CurrentPage & "' onKeyPress=""gopage(this.value,"&TotalPage&")"">页"
		strTemp = strTemp & "<script type='text/javascript'>" & vbCrLf
		strTemp = strTemp & "function gopage(page,totalpage){" & vbCrLf
		strTemp = strTemp & "	if (event.keyCode==13){" & vbCrLf
		strTemp = strTemp & "	if(Math.abs(page)>totalpage) page=totalpage;" & vbCrLf
		If iClassID > 0 Then
			If strUrl <> "" Then
				strTemp = strTemp & "	if(Math.abs(page)>1) window.location='" & strUrl & "page='+Math.abs(page);" & vbCrLf
			Else
				strTemp = strTemp & "	if(Math.abs(page)>1) window.location='" & strPath & "/Index_'+(Math.abs(page))+'" & FileExt & "';" & vbCrLf
			End If
			strTemp = strTemp & "	else window.location='" & strPath & "/Index_"& FileExt & "';" & vbCrLf
		Else
			If strUrl <> "" Then
				strTemp = strTemp & "	if(Math.abs(page)>1) window.location='" & strUrl & "page='+Math.abs(page);" & vbCrLf
			Else
				strTemp = strTemp & "	if(Math.abs(page)>1) window.location='" & strPath & "/Index_'+(Math.abs(page))+'" & FileExt & "';" & vbCrLf
			End If
			strTemp = strTemp & "	else window.location='" & strPath & "/Index" & FileExt & "';" & vbCrLf
		End If
		strTemp = strTemp & "  }" & vbCrLf
		strTemp = strTemp & "}" & vbCrLf
		strTemp = strTemp & "</script>" & vbCrLf
	End If
	strTemp = strTemp & "</div>" & vbCrLf
	ShowPage_Html = strTemp
End Function
%>